.MCALL	.MODULE
.MODULE	SETCOM,VERSION=20,COMMENT=<Setup Command Routines>

; Copyright (c) 1998 by Mentec, Inc., Nashua, NH.
; All rights reserved
;
; This software is furnished under a license for use only on a
; single computer system and  may  be  copied  only  with  the
; inclusion of the above copyright notice.  This software,  or
; any other copies thereof, may not be provided  or  otherwise
; made available to any other person except for  use  on  such
; system and to one who agrees to these license  terms.  Title
; to  and  ownership of the software shall at all times remain
; in Mentec, Inc.
;
; The information in this document is subject to change without
; notice and should not be construed as a commitment by Digital
; Equipment Corporation, or Mentec, Inc.
;
; Digital and Mentec  assume  no  responsibility for the use or
; reliability of its software on equipment which is not supplied
; by Digital  or Mentec,  and listed  in the  Software  Product
; Description.
;
; Author:  David Fingerhut    July 1983
;
; 25-Mar-91	WFG	ACTION #7438 - In SHOW, change CALL SHWCLK to 
;			JMP SHWCLK, because SHWCLK is in another overlay, 
;			and the RETURN path to SHOW would be lost. SHWCLK 
;			now RETURNs directly to the root.

.SBTTL Constants

PL1BIT	=	400		;Color map Plane 1 address bit (LSB)
OPPRES	=	20000		;Options Presence bit (ext bit map present)
.SBTTL	Pure area
	.PSECT PURE

LANUSA:	.ASCII	/DATA,LANG:USA /
	.EVEN
SHWLF:	.ASCIZ	//		;blank line for spacing
SHWNO:	.ASCII	/No /
SHWANS:	.ASCII	/Answerback Message  /<200>
SHWTYP:	.ASCII	\DATA/TYPE Keyboard\<200>
SHWNRC:	.ASCII	/Keyboard NRC/<200>
SHWFNT:	.ASCII	/Video FONT/<200>
SHWISS:	.ASCII	/ is set to /<200>
ENABLD:	.ASCIZ	/enabled/
DSABLD:	.ASCIZ	/disabled/
SHWDAR:	.ASCII	/Device attributes reply string: /<200>
SHWVTD:	.ASCII	/VT100 with processor/<200>
SHWVT1:	.ASCII	/VT100 with AVO and processor/<200>
SHWGFB:	.ASCII	/Generic VT100/<200>
SHWAVO:	.ASCII	/ with AVO/<200>
SHWUNK:	.ASCII	/unknown/<200>
SHOTAB:	.ASCIZ	<12>/Tabstop settings:/
	.EVEN
DEFTBX:	.ASCII	/9:17:25:33:41:49:57:65:73:81:89:97:105:113:121:129I/
	.EVEN
NUMS:	.ASCII	/0123456789/<33>/[7m0123456789/<33>/[m/<200>
	.EVEN
NUMS1:	.ASCII	/0123456789/<33>/[7m012/<33>/[m/<200>
NUMS2:	.ASCII	/0/<200>
	.EVEN
SETSAV:	.RAD50	/SY /
	.RAD50	/SET/
	.RAD50	/UP /
	.RAD50	/SAV/

HTABLE:
	.ASCIZ	/10/			;Use code 1
	.ASCIZ	/12/			;Use code 2
	.ASCIZ	/13/			;Use code 3
	.ASCIZ	/16*.5/			;Use code 4
	.ASCIZ	/5/			;Use code 5
	.ASCIZ	/6/			;Use code 6
	.ASCIZ	/7/			;Use code 7
	.ASCIZ	/8*.25/			;Use code 8
	.BYTE	0
VTABLE:
	.ASCIZ	/6/			;Use code 1
	.ASCIZ	/8/			;Use code 2
	.ASCIZ	/12/			;Use code 3
	.ASCIZ	/2/			;Use code 4
	.ASCIZ	/3/			;Use code 5
	.ASCIZ	/4/			;Use code 6
	.BYTE	0

.SBTTL Impure area
	.PSECT	IMPURE

BIT8:	.WORD	PL1BIT		;Mask to change background color


	.PSECT	CODE
.SBTTL	ANSWER	- Handle ANSWERBACK command
;+
; ANSWER - Collect and set the ANSWERBACK message for a PC
;
;  Input:
;  R4 -> Second character following "SEND"  in the command buffer
;
;  Output:
;  R4 -> Beyond final delimeter of message
;  R0,R1,R2,R3,R5 modified
;-

ANSWER::
	CLR	R5		;Character count
	MOVB	(R4)+,-(SP)	;Save Delimeter
	MOV	#ANSMSG,R1	;R1 -> Answer message buffer
5$:	INC	R5		;Increment character count
	MOVB	(R4),(R1)+	;Move in a character
	BNE	10$		;Branch if it's not a null (end of line)
	TSTB	-(R1)		;Point to the null
	MOVB	#CR,(R1)+	;Replace the null with a CR
	MOVB	#LF,(R1)+	;And put in a LF
	.GTLIN	#LINE		;Get another line
	MOV	#LINE,R4	;R4 -> new line
	BR	5$		;Continue scanning

10$:	CMPB	(R4),(SP)	;End of sequence?
	BEQ	20$		;Branch if so
	TSTB	(R4)+		;Move to next character
	CMP	#ANSMAX,R5	;Answer message too long?
	BGE	5$		;Branch if not
;+
;ERROR
	.ERR	#ERRARE,#ATL,RETURN=NO,LEVEL=F
;	<-F-Answer message too long>
;-

20$:	DEC	R5		;R5 = actual message length
	MOVB	R5,ANSLEN	;Save answermessage length
	TSTB	(SP)+		;Pop off the delimeter
	TSTB	(R4)+		;Skip over delimeter
	CLRB	-(R1)		;Clear out the delimeter

	SPFUN	#IOAREA,#PICHN,#FN$UPD,#ANSLEN,#USEHAN,#ANSR$S,#PIBLK
				;Write the answerback message
	RETURN
.SBTTL	BLOCK	- Handle BLOCK and UNDERSCORE commands
;+
; BLOCK - Handle BLOCK, UNDERSCORE
;
; Input:  R3 = 0 for BLOCK, 1 for UNDERSCORE
;
;-

BLOCK::
	SPFUN	#IOAREA,#PICHN,#FN$UPD,#BLKBUF,#HANUSE,#CURR$S,#PIBLK
				;Read the current table
	MOVB	#D$CUR,R2	;R2 = offset to text cursor mode
	MOVB	BLKBUF(R2),-(SP);Save status of text cursor mode
	BEQ	10$		;Cursor is already off
	MOV	#ESCCRT,R1	;R1 -> sequence to turn off cursor
	CALL	OUTSTR		;Send it
10$:	MOV	#S$CURR,R2	;R2 = offset to block/underscore byte
	MOVB	R3,BLKBUF(R2)	;Turn on block or underscore
	SPFUN	#IOAREA,#PICHN,#FN$UPD,#BLKBUF,#USEHAN,#CURR$S,#PIBLK
				;Write current table back out
	TSTB	(SP)+		;Was text cursor mode on?
	BEQ	90$		;Branch if not
	MOV	#ESCCRR,R1	;R1 -> cursor on
	CALL	OUTSTR		;Send it
90$:	RETURN			;That's it
.SBTTL	BOLD	- Handle BOLD, UNDERLINE and REVERSE commands
;+
; BOLD - Handle [NO]BOLD, [NO]UNDERLINE, [NO]REVERSE
;
;-
	.ENABL	LSB
BOLD::
	MOV	#ESCBOL,R1	;R1 -> BOLD
	TSTB	PRFX		;Prefixed?
	BEQ	10$		;Branch if not
	MOV	#ESCNBO,R1	;R1 -> NOBOLD
	BR	9$		;Common code

UNDERL::
	MOV	#ESCUND,R1	;R1 -> UNDERLINE
	TSTB	PRFX		;Prefixed?
	BEQ	10$		;Branch if not
	MOV	#ESCNUN,R1	;R1 -> NOUNDERLINE
	BR	9$		;Common code

REVERS::
	MOV	#ESCREV,R1	;R1 -> REVERSE
	TSTB	PRFX		;Prefixed?
	BEQ	10$		;Branch if not
	MOV	#ESCNRE,R1	;R1 -> NOREVERSE

9$:	BIT	#DE.PRI,DESTIN	;Is this for printer?
	BNE	10$		;Branch if so
	MOV	#ESCOFF,R1	;R1 -> All attributes off
10$:	CALL	OUTSTR		;Send the sequence
	RETURN			; and return
	.DSABL	LSB
.SBTTL	COLOR	- Set a color on the video
;+
; COLOR - Set a video screen color or set the value of a color (SETCOLOR).
;
; Input: If R3 > 0, R3 -> ADDRESS of mask for the color map.
;	 If R3 = #SETCL then this is SETCOLOR command.
;	 If R3 = #FACCL then this is FACTORY command.
; 	 
;
;-

COLOR::
	CMP	R3,#SETCL	;SETCOLOR?
	BNE	10$		;Branch if not
	BIS	#SC.SEC,FLAGSC	;Indicate SETCOLOR in progress
	CLR	COLREG		;Clear color map register
5$:	JMP	140$		;that's all

10$:	BIT	#SC.VAL,FLAGSC	;Accumulating values for SETCOLOR?
	BNE	40$		;Branch if so
	BIT	#SC.SEC,FLAGSC	;Doing SETCOLOR?
	BNE	30$		;Branch if so
	CMP	R3,#FACCL	;Is this FACTORY?
	BEQ	5$		;Ignore the command
	BIT	#OPPRES,@VIDCSR ;Is the extended bit map present?
	BEQ	20$		;Branch if so
;+
;ERROR
	.ERR	#ERRARE,#EXT,RETURN=NO,LEVEL=F,ASCII=#PBUF
;	<-F-Invalid terminal for command>
;-

20$:	MOV	@R3,R3		;R3 -> color mask
	MOV	@R3,-(SP)	;put mask on stack
	ADD	BIT8,@SP	;Add in the background bit if needed
	MOV	@SP,@CMAP	;Move bits into colormap
	SPFUN	#IOAREA,#PICHN,#FN$UPD,#BLKBUF,#HANUSE,#CURR$S,#PIBLK
				;Read the current setup table
	MOV	#SS$BG,R0	;Assume it's a background color
	TST	BIT8		;Is it for background?
	BEQ	25$		;Branch if so
	MOV	#SS$FG,R0	;It's for text color
25$:	MOV	(SP)+,BLKBUF(R0) ;Save the color in current setup table
	MOV	#PL1BIT,BIT8	;Next color is for text
	SPFUN	#IOAREA,#PICHN,#FN$UPD,#BLKBUF,#USEHAN,#CURR$S,#PIBLK
				;Write current table back out
	BR	140$		;That's all

30$:	MOV	R3,COLSAV	;Save address of color
	BIS	#SC.VAL,FLAGSC	;Indicate we got the color
	BR	140$		;That's all

40$:	CMP	R3,#FACCL	;FACTORY?
	BNE	50$		;Branch if not
	MOV	COLSAV,R3	;R3 -> address of address of current mask
	TST	(R3)+		;R3 -> 350 factory value
	MOV	@R3,COLREG	;R0 = factory value
	BR	130$		;Write it out	

50$:	MOV	@R3,R1		;R1 -> mask for primary color
	CALL	GETBIN		;Get value associated with the color in R0
	BCS	60$		;Branch on error
	CMP	#15.,R0		;Under 16?
	BLT	60$		;Branch if not
	BIT	#FL.380,FLAGWD	;Is this a 380?
	BNE	70$		;Branch if so
	ASR	R0		;Divide by 2 for 350
	CMP	R1,#CLBLU	;Is it BLUE?
	BNE	70$		;Branch if not
	ASR	R0		;Divide by 2 again for BLUE on 350
70$:	CMP	R1,#CLRED	;Red?
	BNE	90$		;Branch if not
	BIS	#SC.RED,FLAGSC	;Indicate RED given
	BIT	#FL.380,FLAGWD	;Is this a 380?
	BEQ	81$		;Branch if not
	BIT	#1,R0		;Is low bit set?
	BEQ	80$		;Branch if not
	BIS	#2000,R0	;Set up to roll into high bit
80$:	ASR	R0		;Clear out low bit
81$:	SWAB	R0		;Move value into high byte
	ROR	R0		;Move value into
	ROR	R0		; RED
	ROR	R0		;  position.
	BR	120$
	
90$:	CMP	R1,#CLGRE	;Green?
	BNE	110$		;Branch if not
	BIS	#SC.GRE,FLAGSC	;Indicate GREEN given
	BIT	#FL.380,FLAGWD	;Is this a 380?
	BEQ	100$		;Branch if not
	BIT	#1,R0		;Is low bit set?
	BEQ	101$		;Branch if not
	BIS	#20000,R0	;Set up to shift low bit in
	BIC	#1,R0		;Turn off low bit
	BR	101$		;Just one shift for 380

100$:	ASL	R0		;Move value into GREEN area
101$:	ASL	R0		;Move value into GREEN area
	BR	120$

110$:	CMP	R1,#CLBLU	;Blue?
	BNE	150$		;Branch if not
	BIS	#SC.BLU,FLAGSC	;Indicate BLUE given
	BIT	#FL.380,FLAGWD	;Is this a 380?
	BEQ	120$		;Branch if not
	MOV	R0,R1		;Save it
	ASR	R0
	ASR	R0
	SWAB	R1
	ASL	R1
	ASL	R1
	ASL	R1
	ASL	R1
	BIC	#140000,R1
	BIS	R1,R0
	
120$:	BIS	R0,COLREG	;Move in the color
	CMP	#<SC.SEC!SC.VAL!SC.BLU!SC.GRE!SC.RED>,FLAGSC	;Got them all?
	BNE	140$		;Branch if not
130$:	CALL	WRTCOL		;Write out the new color values	
140$:	RETURN

;+
;ERROR
60$:	.ERR	#ERRARE,#IVV,RETURN=NO,LEVEL=F,ASCII=#PBUF
;	<-F-Invalid value:>
;-
;+
;ERROR
150$:	.ERR	#ERRARE,#IVC,LEVEL=F,RETURN=NO,ASCII=#PBUF
;	<-F-Invalid command:>
;-
.SBTTL	DEFALT	- Handle DEFAULTS command
;+
; DEFALT - Reset current characteristics to factory defaults.
; FACTORY OPTIONS -> CURRENT MEMORY OPTIONS
; Colors are set from current settings
; FACTORY TABS -> CURRENT MEMORY TABS
; CURRENT MEMORY ANSWERBACK MESSAGE is set to NULL
; CURRENT MEMORY REPLY is set to VT100
; CURSOR is forced on and SCREEN is set to DARK
; 
; The command DATA,LANG:USA command will then be stuffed into the command
; buffer so it gets executed.
;-

DEFALT::

	MOV	#ESCCRT,R1	;R1 -> turn off cursor
	CALL	OUTSTR		;Send it
	MOV	#ESC80,R1	;R1 -> 80 column mode
	CALL	OUTSTR		;Send it
	MOV	#ESCDRK,R1	;R1 -> sequence for DARK
	CALL	OUTSTR		;Send it

	MOV 	#SETD.F,SETOF 	;Request the factory setup table 
	CALL 	GETTAB 		;Read it into BLKBUF: REQDAT -> table 
	SPFUN #IOAREA,#PICHN,#FN$UPD,REQDAT,#USEHAN,#CURR$S,#PIBLK 
				;Write out the current table 
	BIT	#OPPRES,@VIDCSR ;Is the extended bit map present?
	BNE	20$		;Branch if not
	MOV	REQDAT,R1	;R1 -> current setup data
	MOV	#SS$BG,R0	;R0 = offset to background color
	ADD	R1,R0		;R0 -> background color
	MOV	@R0,@CMAP 	;Set the background color
	MOV	#SS$FG,R0	;R0 = offset to text color
	ADD	R1,R0		;R0 -> text color
	MOV	@R0,@CMAP 	;Set the text color

20$:	MOV	#TABS.F,SETOF	;Request factory tabs area
	CALL	GETTAB		;Get it
	SPFUN	#IOAREA,#PICHN,#FN$UPD,REQDAT,#USEHAN,#TABS$S,#PIBLK
				;Write out the current TABS	

	SPFUN #IOAREA,#PICHN,#FN$UPD,#SHWLF,#USEHAN,#ANSR$S,#PIBLK 
				;Clear answerback buffer 

	CLR	R3		;Indicate entering VT100 mode
	CALL	VT100		;Set reply to VT100

	MOV 	#ESCCRR,R1 	;R1 -> turn on cursor 	
	CALL	OUTSTR		;Send it

	MOV	#LANUSA,R1	;R1 -> DATA,LANG:USA command 
	ADD	#14.,R1		;R1 -> end of DATA,LANG:USA command (null byte)
	MOV	#14.,R0		;Length of command with null
10$:	MOVB	-(R1),-(R4)	;Move in a byte
	SOB	R0,10$		;Move in whole command

	RETURN			;Return

.SBTTL  HELP	- Handle HELP command
;+
; HELP
;
; A command's help message should be printed if all of the bits in 
;  (DESTIN & TERMWD) are set in the flagword (from SETCOM) for the command.
; The exception is that if the destination is PRINTER (DE.PRI in DESTIN)
;  the processor can be either an 11 or a PC.
;-

HELP::
	CALL	$SAVAL		;Save all regs
	BIT	#FL.DES,FLAGWD	;Was a destination specified?
	BNE	10$		;Branch if so
	.PRINT	#HPHLP		;Print general help message
	BR	110$		;That's all
10$:	CLR	R2		;R2 = offset into setcom tables
20$:	MOV	HELADD(R2),R1	;R1 = address of help message
	BMI	110$		;Branch if no more messages
	BEQ	90$		;Branch if no message
	MOV	COMFLG(R2),R0	;R0 = flags for the command
	MOV	DESTIN,R4	;R4 = Destination bits
	BIT	#DE.PRI,R4	;Is the destination PRINTER?
	BEQ	25$		;Branch if not
	BIS	#PR.PC,R0	;Printer command is OK on any processor
25$:	BIS	TERMWD,R4	;R4 = termid + destination bits
	BIC	R0,R4		;Are all the bits in R4 set in R0?
	BNE	90$		;Branch if not
	.PRINT	R1		;Print the message
90$:	TST	(R2)+		;Point to next flag
	BR	20$		;Check next command

;	.PRINT	#HPCOL		;Print help for colors
110$:	RETURN
.SBTTL	HORIZ	- Handle HORIZONTAL command
;+
; HORIZ
;
; Input: R4 -> Second character following "HORIZ" in the command buffer
; 
; Output: R4 updated beyond value and comma
; R1,R2,R0 MODIFIED
;
;-

VERT::
	MOV	#VTABLE,R2	;R2 -> Vertical value table
	MOV	#ESCVER,R3	;R3 -> Vertical escape sequence	
	JMP	COM		;Join common code
HORIZ::
	MOV	#HTABLE,R2	;R2 -> Horizontal value table
	MOV	#ESCHOR,R3	;R3 -> Horizontal escape sequence

COM:	CALL	GETCOM		;Get value in PBUF (R0 -> PBUF)
	CALL	TBSRC		;Search the table for it.
	BCC	10$		;Branch if found
;+
;ERROR
	.ERR	#ERRARE,#IVV,#RETURN=NO,LEVEL=FATAL,ASCII=#PBUF
;	<-F-Invalid value for command>
;-

10$:	BIT	#FL.AMB,FLAGWD	;Is it an ambiguous value
	BEQ	11$		;Branch if not
;+
;ERROR
	.ERR	#ERRARE,#AMV,#RETURN=NO,LEVEL=FATAL,ASCII=#PBUF
;	<-F-Ambiguous value for command>
;-
11$:	ASR	R1		;Make into word offset
	INC	R1		;Make into index
	BIS	#60,R1		;Convert index to ASCII
	MOVB	R1,2(R3)	;Move in the code
	MOV	R3,R1		;R1 -> Escape sequence to send
	CALL	OUTSTR		;Send it
	RETURN
.SBTTL	INT480	- Handle 480INTERLACE
;+
; INT480 - Put terminal in 480INTERLACE mode.
;
;-

INT480::
	BIT	#FL.380,FLAGWD		;Is this a 380?
	BNE	10$			;Branch if so
;+
;ERROR
	.ERR	#ERRARE,#IVT,RETURN=NO,LEVEL=FATAL
;	-F-Invalid processor for command
;-

10$:	BIS	#CSR480,@VIDCSR		;Set 480 interlace
	MOV	#ESCRES,R1		;Point to RESET sequence
	CALL	OUTSTR			;Send it
	RETURN	
.SBTTL	ON	- Handle ON command
;+
; ON - The following color is for the screen background
;
;-

BACKG::
	CLR	BIT8		;Don't set Plane 1 bit
	RETURN
.SBTTL	PAGE	- Handle PAGE command
;+
; PAGE - Set page length
;
; Input:
;	R4 -> Second character following "PAGELENGTH" in the command buffer
; Output:
;	R4 updated beyond value and terminator
;-

PAGE::
	MOV	#ESCPAG+2,R1	;R1 -> where to put digits
	CALL	GETDIG		;Get first digit
	BCS	90$		;Branch if no digit
10$:	MOVB	R3,(R1)+	;Move in first digit
	CALL	GETDIG		;Get second digit
	BCC	10$		;Continue on
	MOVB	#'t,(R1)+	;Add in last character
	CLRB	(R1)		;And zero byte
90$:	MOV	#ESCPAG,R1	;R1 -> final sequence
	CALL	OUTSTR		;Send it
	RETURN
.SBTTL  SAVE	- Handle SAVE command
;+
; SAVE
; Saves the state table, answerback message, reply buffer, tabs table.
; The current memory copies are copied to memory permanent, disk current, and
; disk permanent.
;	
;-

SAVE::
	MOV	#SAVBLK,R1	;R1 -> SAVDAT parameter block

	MOV	#SETD.C,(R1)	;Set the parameters for the options table
	MOV	#SETD.P,2(R1)	;
	MOV	#CURR$S,4(R1)	;
	MOV	#PERM$S,6(R1)	;
	CALL	SAVDAT		;Save the options table

	MOV	#ANSR.C,(R1)	;Set the parameters for the answerback msg
	MOV	#ANSR.P,2(R1)	;
	MOV	#ANSR$S,4(R1)	;
	MOV	#ANSR$P,6(R1)	;
	CALL	SAVDAT		;Save the answerback message

	MOV	#REPL.C,(R1)	;Set the parameters for the reply
	MOV	#REPL.P,2(R1)	;
	MOV	#REPL$S,4(R1)	;
	MOV	#REPL$P,6(R1)	;
	CALL	SAVDAT		;Save the reply

	MOV	#TABS.C,(R1)	;Set the parameters for the reply
	MOV	#TABS.P,2(R1)	;
	MOV	#TABS$S,4(R1)	;
	MOV	#TABS$P,6(R1)	;
	CALL	SAVDAT		;Save the tabstops

	RETURN
.SBTTL  SHOW	- Handle SHOW command
;+
; SHOW
;-

SHOW::
	.PRINT	#SHWLF		;Print blank line
	BIT	#DE.TER,DESTIN	;Show TERMINAL?
	BNE	10$		;Branch if so
	JMP	SHWCLK		;show clock - JMP to another overlay
				; RETURN directly from SHWCLK

10$:	MOV	R4,-(SP)	;Save R4
	SPFUN	#IOAREA,#PICHN,#FN$UPD,#BLKBUF,#HANUSE,#CURR$S,#PIBLK
				;Read in the current table
	SPFUN	#IOAREA,#PICHN,#FN$UPD,#BLKBF1,#HANUSE,#SETS$S,#PIBLK
				;Read in the SETS table
	MOV	#BLKBUF,R4	;R4 -> current state table

	MOV	#D$COLM,R1	;R1 = offset for 80/132 column
	MOVB	BLKBUF(R1),R5	;R5 = D$COLM contents
	CLR	R1		;R1 = offset into COMADD,COMFLG and COMSET
	MOV	#COMTXT,R2	;R2 -> text of command
20$:	BIT	#<FLRST!FLSET>,COMFLG(R1) ;Is this a PISET offset?
	BEQ	90$		;Branch if not

	MOV	#PRBUF,R3	;R3 -> Print buffer
	MOV	#PRLEN,R0	;R0 = length of print buffer
30$:	MOVB	#BL,(R3)+	;fill the buffer
	SOB	R0,30$		;with blanks
	MOV	#PRBUF,R3	;R3 -> Print buffer
40$:	CMPB	#'*,(R2)	;Is it an asterisk
	BEQ	50$		;Branch if so
	MOVB	(R2),(R3)+	;Move in a byte
50$:	TSTB	(R2)+		;Is it 0?
	BNE	40$		;Branch if not
	MOVB	#BL,-(R3)	;Move in final space
	DEC	R2		;Point to the null
	.PRINT	#PRBUF		;Print the command and "is set"
	MOV	COMSET(R1),R0	;R0 = offset for PISET command status
	CMP	#DATA,COMADD(R1);Is this DATA or TYPE command?
	BNE	55$		;Branch if not
	MOVB	BLKBF1(R0),R0	;R0 = status of the command
	BR	56$		;continue

55$:	MOVB	BLKBUF(R0),R0	;R0 = status of the command
56$:	BIT	#FLSET,COMFLG(R1) ;Does a "1" mean the command is "enabled"?
	BEQ	60$		;Branch if not
	TST	R0		;Is it a one?
	BNE	80$		;Branch if so - Print "enabled"
	BR	70$		;Otherwise, print "disabled"

60$:	TST	R0		;Is it a one?
	BEQ	80$		;Branch if not
70$:	.PRINT	#DSABLD		;Print "disabled"
	BR	90$

80$:	.PRINT	#ENABLD		;Print "enabled"
90$:	INC	R1		;Point to
	INC	R1		; next entry
	TST	COMFLG(R1)	;Are we at end of table?
	BEQ	110$		;Branch if at end
100$:	TSTB	(R2)+		;Loop to next command
	BNE	100$		;
	BR	20$		;Check next command

110$:
	SPFUN	#IOAREA,#PICHN,#FN$UPD,#ANSLEN,#HANUSE,#ANSR$S,#PIBLK
				;Read the ANSWERBACK message
	MOV	#ANSLEN,R1	;R1 -> answerback buffer
	TSTB	(R1)		;Is there any message?
	BNE	120$		;Branch if so
	.PRINT	#SHWNO		;Print "No Answerback message "
	.PRINT	#SHWLF		;End of line
	BR	130$		;And continue

120$:	.PRINT	#SHWANS		;Print "Answerback message   "
	.PRINT	#ANSMSG		;Print the message

130$:	SPFUN	#IOAREA,#PICHN,#FN$UPD,#BLKBUF,#HANUSE,#REPL$S,#PIBLK
				;Read the reply
	MOV	#BLKBUF,R3	;R3 -> reply
	.PRINT	#SHWDAR		;Print "Device Attributes Reply String:"
	MOV	#ESCID1,R2	;R2 -> VT100 string
	CALL	CMPAR		;Is it VT100?
	BCS	140$		;Branch if not
	BIT	#FL.AMB,FLAGWD	;Is it ambiguous?
	BNE	140$		;If so, not a match
	.PRINT	#SHWVT1		;Print "VT100 with AVO and processor"
	BR	149$		;and conitnue

140$:	MOV	#ESCIDF,R2	;R2 -> Generic FB string
	CALL	CMPAR		;Is it generic fb?
	BCS	142$		;Branch if not
	BIT	#FL.AMB,FLAGWD	;Is it ambiguous?
	BNE	142$		;Branch  if so - no match
	.PRINT	#SHWGFB		;Print "Generic VT100"
	BR	149$		;and continue

142$:	MOV	#ESCIDX,R2	;R2 -> Generic XM string
	CALL	CMPAR		;Is it generic FB?
	BCS	143$		;Branch if not
	BIT	#FL.AMB,FLAGWD	;Is it ambiguous?
	BNE	143$		;Branch if so - no match
	.PRINT	#SHWGFB		;Print "Generic VT100"
	.PRINT	#SHWAVO		;Print " with AVO"	
	BR	149$

143$:	MOV	#ESCIDD,R2	;R2 -> Default reply string
	CALL	CMPAR		;Is it VT100 with AVO?
	BCS	144$		;Branch if not
	BIT	#FL.AMB,FLAGWD	;Is it ambiguous?
	BNE	144$		;Branch if so - no match
	.PRINT	#SHWVTD		;Print "VT100 with processor"
	BR	149$
	
144$:	.PRINT	#SHWUNK		;Print "unknown"
149$:	.PRINT	#SHWLF
	.PRINT	#SHOTAB
	SPFUN	#IOAREA,#PICHN,#FN$UPD,#BLKBUF,#HANUSE,#TABS$S,#PIBLK
				;Read the current tabs table
	MOV	#80.,R0		;Assume 80 column
	TST	R5		;Is it 80 column?
	BEQ	150$		;Branch if so
	MOV	#132.,R0	;132 column
150$:	MOV	#ESCBUF,R1	;R1 -> buffer to record tabs stops
	MOV	#BLKBUF,R2	;R2 -> current tab stops
160$:	MOVB	#BL,(R1)	;Assume no tabs stop
	TSTB	(R2)+		;Is there a tab at the location?
	BEQ	170$		;Branch if not
	MOVB	#'T,(R1)	;Move a T into this column
170$:	INC	R1		;Point to next column
	SOB	R0,160$		;Do for each column
	CLRB	(R1)		;Null stopper
	.PRINT	#ESCBUF		;Print the T's
	MOV	#3,R1		;Print first 80 numbers
	TST	R5		;Is it 80 col mode
	BEQ	180$		;Branch if so
	MOV	#5,R1		;Print 120 numbers
180$:	.PRINT	#NUMS+1		;Print 19 digits
181$:	.PRINT	#NUMS		;Print 20 digits
	SOB	R1,181$		;Print the rest
	TST	R5		;Is it 80 column mode?
	BEQ	189$		;Branch if so
	.PRINT	#NUMS1		;Print 12 more
	BR	190$		;Thats end of line
189$:	.PRINT	#NUMS2		;Print final 0
190$:	.PRINT	#SHWLF		;Line feed

	SPFUN	#IOAREA,#PICHN,#FN$UPD,#BLKBUF,#HANUSE,#SETS$S,#PIBLK
				;Read in the current table
	.PRINT	#SHWNRC
	.PRINT	#SHWISS
	MOV	#S$KBLA,R1
	MOV	#4,R0		;R0 = counter
	MOV	#PRBUF,R2	;R2 -> print buffer
200$:	MOVB	BLKBUF(R1),(R2)+ ;Move a byte
	INC	R1		;Point to next byte
	SOB	R0,200$		;Loop until done
	CLRB	(R2)		;End with null
	.PRINT	#PRBUF		;Print the language
	.PRINT	#SHWFNT		;Print "Video FONT"
	.PRINT	#SHWISS		;Print "is set"
	MOV	#S$VDLA,R1	;R1 = offset to font
	MOV	#4,R0		;R0 = counter
	MOV	#PRBUF,R2	;R2 -> print buffer
210$:	MOVB	BLKBUF(R1),(R2)+ ;Move a byte
	INC	R1		;Point to next byte
	SOB	R0,210$		;Loop until done
	CLRB	(R2)		;End with null
	.PRINT	#PRBUF		;Print the language
220$:	MOV	(SP)+,R4	;Restore R4
	RETURN
.SBTTL  TABS	- Handle TABS command
;+
; TABS
; Input:  
;  R4 -> Second character following "TABS" in the command buffer
;
; Output:
;  R4 -> Updated beyond command, tabstops and comma
;  R0 modified
;-

TABS::
	TSTB	PRFX		;Clear all tabs?
	BEQ	10$		;Branch if not
	MOV	#ESCTBC,R1	;R1 -> Esc seq for Clear Tabs
	CALL	OUTSTR		;Send the sequence
	JMP	90$		; and return		

10$:	BIT	#FL.PRM,FLAGWD	;Are there any parameters?
	BNE	145$		;Branch if so
	BIT	#PR.11,TERMWD	;Are we on an 11?
	BNE	14$		;Branch if so

	MOV	#TABS.F,SETOF	;Request factory tabs table
	CALL	GETTAB		;Get it
	SPFUN	#IOAREA,#PICHN,#FN$UPD,REQDAT,#USEHAN,#TABS$S,#PIBLK
				;Write out the factory tabs table
	BR	90$		;Thats all

14$:	MOV	R4,-(SP)	;Save rest of commands
	MOV	#ESCTBC,R1	;R1 -> Esc seq for Clear Tabs
	CALL	OUTSTR		;Send the sequence
	MOV	#DEFTBX,R4	;Point to long tab string
145$:	MOV	#ESCBUF,R5	;R5 -> buffer for sequences
15$:	MOV	#ESCLFT,R1	;R1 -> go to left margin
	CALL	ADTAB		;Send it
	MOV	#ESCCUR+2,R1	;R1 -> location in ESCCUR for digit
20$:	CALL 	GETDIG		;Get first digit in R3
	BCS	30$		;Branch if non-digit found
	MOVB	R3,(R1)+	;Move digit into escape sequence
	BR	20$		;Get next digit

30$:	CMP	#ESCCUR+2,R1	;Were any digits found?
	BEQ	40$		;Branch if not
	MOVB	#'C,(R1)+	;Move in final character
	CLRB	(R1)		;And add final 0
	MOV	#ESCCUR,R1	;R1 -> esc seq to position cursor
	CALL	ADTAB		;Move the cursor
	MOV	#ESCLF1,R1	;R1 -> esc seq to move left 1 column
	CALL	ADTAB		;Move left
	MOV	#ESCTAB,R1	;R1 -> esc seq to set a tab
	CALL	ADTAB		;Set the tab
	
	CMPB	#':,R3		;More tabs to set?
	BNE	50$		;Branch if not
	TSTB	(R4)+		;Skip past colon
	BR	15$		;Set next tab

40$:	MOV	#ESCSCR,R1	;R1-> esc seq to clear screen
	CALL	OUTSTR		;Print it at top of screen
;+
;ERROR
	.ERR	#ERRARE,#IVV,LEVEL=F,RETURN=NO,ASCII=#PBUF
;	<-F-Invalid value for command>
;-

50$:	MOVB	#CR,(R5)+	;Put in CR
	CLRB	(R5)+		;Put in final null
	MOV	#ESCBUF,R1	;Point to the sequences
	CALL	OUTSTR		;Send them

60$:	BIT	#FL.PRM,FLAGWD	;Were there parameters?
	BNE	90$		;Branch if so
	MOV	(SP)+,R4	;Restore original command line
90$:	RETURN
ADTAB:	
	TSTB	(R1)		;Is there anything there?
	BEQ	20$		;Branch if not
	MOVB	#ESCAPE,(R5)+	;Move in the escape
10$:	MOVB	(R1)+,(R5)+	;move in a byte
	BNE	10$		;Branch if not null
	TSTB	-(R5)		;Back up over null
20$:	RETURN
.SBTTL	VT100	- Handle VT100 and GENERIC100
;+
; VT100 - Set the terminal identifier string
;
; Input: R3 = 0 if command was VT100
;	    -> ESCGEN if command was GENERIC100
;
;-

VT100::
	BIT	#PR.PC,TERMWD	;Is this a PC?
	BNE	11$		;Branch if so
	MOV	R3,R1		;R1 -> 0 (for VT100) or ESCGEN (for GENERIC)
	BNE	10$		;Branch if set for GENERIC
	MOV	#ESCVT1,R1	;R1 -> ANSI escape sequence
10$:	CALL	OUTSTR		;Send it
	BR	90$		;That's all

11$:	TST	R3		;Is it VT100?
	BNE	12$		;Branch if not
	MOV	#ESCID1,R1	;R1 -> Reply for VT100 XM
	BIT	#FL.XM,FLAGWD	;Is this XM?
	BNE	15$		;Branch if so
	MOV	#ESCIDD,R1	;R1 -> Reply for VT100 FB
	BR	15$

12$:	MOV	#ESCIDX,R1	;R1 -> Reply for GENERIC XM
	BIT	#FL.XM,FLAGWD	;Is this XM?
	BNE	15$		;Branch if so
	MOV	#ESCIDF,R1	;R1 -> Reply for GENERIC FB
15$:	SPFUN	#IOAREA,#PICHN,#FN$UPD,R1,#USEHAN,#REPL$S,#PIBLK
				;Write the reply
90$:	RETURN

	.END