.TITLE	SCRFT	Screen package for foreign terminals
;			FT1 = CONCEPT 100
;			FT2 = ANN ARBOR K4080D
;			FT3 = ADM3A
;			FT4 = ANN ARBOR AMBASSADOR
;			FT5 = (unassigned)
;			FT6 = (unassigned)
;			FT7 = TELERAY
;			FT8 = TEKTRONICS 4027
	.IDENT	'V03-000'
	.SBTTL	Copyright Notice
;
;****************************************************************************
;*									    *
;*  COPYRIGHT (c) 1978, 1979, 1980                                          *
;*  BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.			    *
;* 									    *
;*  THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND  COPIED  *
;*  ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH  LICENSE AND 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.  NO TITLE TO AND OWNERSHIP OF  THE  SOFTWARE  IS  HEREBY  *
;*  TRANSFERRED.							    *
;* 									    *
;*  THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE  WITHOUT  NOTICE  *
;*  AND  SHOULD  NOT  BE  CONSTRUED  AS  A COMMITMENT BY DIGITAL EQUIPMENT  *
;*  CORPORATION.							    *
;* 									    *
;*  DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF  ITS  *
;*  SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.		    *
;*									    *
;****************************************************************************
;
;
;
;
;                         - - N O T I C E - -
;
; ____________________________________________________________________
;|                                                                    |
;| This document and the material and data contained therein, was     |
;| developed under sponsorship of the U. S. Government.  Neither the  |
;| U. S. nor the U. S. D. O. E., nor the Leland Stanford Junior       |
;| University, nor their employees, nor their respective contractors, |
;| subcontractors, or their employees, makes any warranty, express or |
;| implied, or assumes any liability or responsibility for accuracy,  |
;| completeness or usefulness of any information, apparatus, product  |
;| or process disclosed, or represents that its use will not infringe |
;| privately-owned rights.  Mention of any product, its manufacturer, |
;| or suppliers shall not, nor is it intended to, imply approval,     |
;| disapproval, or fitness for any particular use.  A royalty-free,   |
;| nonexclusive right to use and disseminate same for any purpose     |
;| whatsoever, is expressly reserved to the U. S. and the University. |
;|                                                             2/80   |
;|____________________________________________________________________|
	.PAGE
	.SBTTL	Program description
;
;   Facility
;
;	Screen Package for foreign terminal functions
;
;   Environment
;
;	Native mode, User mode, Shared library routines
;
;	When this program is linked, the image should be copied to
;	SYS$LIBRARY:SCRFT.EXE and, if desired, installed to improve
;	the image activation speed.  The screen package will automatically
;	"merge" this image into the calling image's address space when
;	needed.  To debug it, simply link it /DEBUG and define a logical name
;	SCRFT to be the file spec of the test image.  NOTE: the debugger
;	performs a $EXIT system service upon exit, therefore you will only
;	be able to debug the first invocation of SCRFT.
;
;   Author
;
;	Tim Halvorsen, February 1980
;
;   Modified by
;	P.Schreiner     Argonne National Lab  Nov 1980
;       Edgar Whipple   LBL  Oct 1980   Add ADM3 support as FT3.
;	C. Granieri	SLAC Dec 1980
;	Ed Miller	UCSD Dec 1980
;	F. J. Nagy	Fermilab 20-Sep-82	Bring comments up to VMS V3
;
;--

	.sbttl	Symbol Definitions

;
;	Symbol Defintions
;
	$scrdef				; Screen package definitions

bs	=	^x08			; Backspace
lf	=	^x0a			; Line feed
cr	=	^x0d			; Carriage return
esc	=	^x1b			; Escape character
lb	=	^a'['			; Left bracket 
sub     =       ^x1a                    ; sub = control-z (ADM3)
cb	=	^X1F			; line/column bias in message
semi	=	^X3B			; semi-colon

CP100_SC  = ^a'a'		; CP100 set cursor position
CP100_DWN = ^a';'		; CP100 down scroll
CP100_EOS = ^X05		; CP100 erase to end of screen
CP100_EOL = ^X13		; CP100 erase to end of line
CP100_HOME= ^a'?'               ; cp100 home
CP100_PRM =^a'U'		; cp100 programmer mode key

annarbor_SC	= ^X0F		; annarbor set cursor position
annarbor_HOME	= ^X0C		; annarbor set to home and erase screen
annarbor_EOS	= ^X0C		; annarbor erase to end of screen
annarbor_DWN    = ^X0E          ; annarbor down scroll

teleray_SC  = ^X59		; teleray set cursor position
teleray_DWN = ^X41		; teleray down scroll
teleray_EOS = ^X4A		; teleray erase to end of screen
teleray_EOL = ^X4B		; teleray erase to end of line
teleray_HOME= ^X6A              ; teleray home and erase screen

amb_SC = ^A'H'			; ambassador set cursor position
amb_DWN = ^A'A'			; ambassador down scroll (cursor up)
amb_EOS = ^A'J'			; ambassador erase to end of screen
amb_EOL = ^A'K'			; ambassador erase to end of line
 
ADM3_SC         = ^A'='         ; ADM3 set cursor position
ADM3_HOME       = sub           ; ADM3 set to home and erase screen
ADM3_EOS        = 0             ; ADM3 erase to end of screen unavailable
ADM3_EOL        = 0             ; ADM3 erase to end of line unavailable
ADM3_DWN	= ^X0B		; ADM3 DOWN SCROLL

;the tekronix 4027 commands are many bytes long and complicated
;so, do not use symbol definitions; code inline instead
;FAO commands require use of ! symbol, but standare 4027 command
;character is also !.  Therefore, use !! in commands to Tektronix.
;After moving cursor,always insert an "escape" character so the
;first character of the next message will not be mis-interpreted by
;the Tektronix as the end of the position field in the "move cursor"
;command.



;
;	Macro definitions
;

	.macro	string	text,?l1,?l2
	.save
	.psect	_scr$strings,exe,nowrt,pic
l1:	.ascii	text
l2:
	.restore
	.long	l2-l1
	.long	l1-<.-4>
	.endm	string

;
;	modify Halvorsen CASE variables to agree with DEC manuals
;
	.macro	case src,displist,type=w,base=#0,?astr,?aend
	case'type	src,base,#<<aend-astr>/2>-1
astr:
	.irp	ep,<displist>
	.word	ep-astr
	.endr
aend:
	.endm

	.psect	_scr$code,exe,nowrt,pic

	.sbttl	DISPATCHER	Dispatch to proper request routine
;---
;
;	This is the main entry point of the image.  Dispatch
;	to the proper screen package routine for the foreign
;	terminal.
;
; Inputs:
;
;	28(ap) = Address of argument list:
;		00) Number of longword arguments
;		04) Address of SCR argument list
;		08) Screen package request #
;		12) Foreign terminal #
;		16) Address of retbuf descriptor
;		20) Address of retlen word
;
; Outputs:
;
;	Dispatch to routine with:
;
;	ap = Address of SCR argument list
;	r1 = Foreign terminal number (biased at zero; ft1=0)
;	r11 = Address of above argument list
;
;---
dispatcher:
	.word	^m<r11>

	movl	28(ap),r11		; r11 = address of SCRFT args
	callg	@4(r11),b^10$		; call with SCR argument list
	ret
10$:	.word	0
	subl3	#1,12(r11),r1		; r1 = Foreign terminal number - 1
	case	8(r11),type=w,<-	; Case on request type
		put_screen,-		; SCR$PUT_SCREEN
		get_screen,-		; SCR$GET_SCREEN
		erase_page,-		; SCR$ERASE_PAGE
		erase_line,-		; SCR$ERASE_LINE
		set_cursor,-		; SCR$SET_CURSOR
		down_scroll>		; SCR$DOWN_SCROLL
exit:	movl	#1,r0
	ret

	.sbttl	POS_OUTPUT	Insert line,col in output message
;---
;
;	This routine is used to insert a screen position
;	into a string before writing the message to the
;	terminal.
;
; Calling sequence:
;
;	Branch from CALLed routine
;
; Inputs:
;
;	R1 = Address of control string descriptor (address is self-relative)
;	4(ap) = Line number
;	8(ap) = Column number
;	r11 = SCRFT arguments
;
;	1 optional argument to the fao string may be placed
;	on the top of the stack on entry to this routine.
;
;---

hextoasc:
	.ascic	'!UL;!UL'		; Convert to Ambassador sequences
tekcomma:
	.ascic	'!UL,!UL'		; tek4027 comma needed

pos_output:
	movl	(sp),r0			; Save optional argument
	case	12(r11),type=b,base=#1,<- ; Case on terminal type
		10$,-			; cp100
		20$,-			; annarbor
		30$,-			; adm3a
		40$,-			; ann arbor ambassador
		50$,-			;
		60$,-			;
		70$,-			; teleray
                80$>                    ; tek4027

10$:	addb3	#31,4(ap),(sp)         ;concept 100 line numbers
                                       ;start at 0;but the command is
                                       ;offset by 32
	addb3   #31,8(ap),1(sp)
	movb	#2,-(sp)
	brw	90$

20$:                                   ;ann arbor address is messy
        PUSHR   #^M<R1,R4>		;SAVE REGISTERS
;		  YCODE = ((IY-1)/20)*12 + 64 + IY-1	(LINE)
	SUBL3	#1,4(AP),R4
	DIVL3	#20,R4,R1
	MULL2	#12,R1
	ADDL2	#64,R1
	ADDL3	R1,R4,4(AP)
;
;		  XCODE = ((IX-1)/10)*6 + IX-1	(COLUMN)
	SUBL3	#1,8(AP),R4
	DIVL3	#10,R4,R1
	MULL2	#6,R1
	ADDL3	R1,R4,8(AP)
;
        POPR    #^M<R1,R4>		;RESTORE REGISTORS
;
	movl	8(ap),(sp)              
 	movl    4(ap),1(sp)
	movb	#2,-(sp)		; Length of string
        brb     90$
30$:
        addb3   #31,8(ap),1(sp)         ; Line number
        addb3   #31,4(ap),(sp)          ; Column number
	movb	#2,-(sp)		; Length of string
	brb	90$
40$:					; Ann Arbor Ambassador
    	subl	#16,sp			; Allocate FAO output buffer
	pushr	#^m<r0,r1>		; Save registers
	movab	hextoasc,r1
	brb	82$
50$:
60$:
	brw	exit
70$:					; teleray
        addb3   #31,8(ap),1(sp)         ; 
        addb3   #31,4(ap),(sp)          ; 
	movb	#2,-(sp)		; Length of string
	brb	90$
80$:					;tekronix 4027 needs , in middle
    	subl	#16,sp			; Allocate FAO output buffer
	pushr	#^m<r0,r1>		; Save registers
	movab   tekcomma,r1
82$:
	pushab	9(sp)			; Create descriptor of buffer
	pushl	#15
	movzbl	(r1)+,r0
	movq	r0,-(sp)		; Push descriptor of string onto stack
	movl	sp,r0			; Address of stack arguments
	pushl	8(ap)			; Column number
	pushl	4(ap)			; Line number
	$fao_s	(r0),8(r0),8(r0)	; Convert to ASCII characters
	movb	16(sp),32(sp)		; Copy length into ASCIC string
	addl	#24,sp			; Leave buffer on top of stack
	popr	#^m<r0,r1>		; Restore registers
90$:
	subl	#256,sp			; Allocate FAO buffer
	pushl	sp			; Create descriptor for buffer
	pushl	#256
	movq	(r1),-(sp)		; Move descriptor of string on stack
	addl	r1,4(sp)		; Relocate self-relative address
	pushl	r0			; Optional extra argument
	movab	4(sp),r0
	pushab	4+16+256(sp)		; Address of counted string
	$fao_s	(r0),8(r0),8(r0)	; Insert into output string
	addl	#16,sp			; Pop everything but fao buffer
	movl	sp,r1			; Address of descriptor
	subl	sp,4(r1)		; Make into self-relative address
	brb	output

	.sbttl	OUTPUT		Write string to terminal
;---
;
;	OUTPUT
;
;	This routine writes the specified string to the
;	terminal without carriage control.
;
; Calling sequence:
;
;	Branch from CALLed routine
;
; Inputs:
;
;	r1 = Address of string descriptor (the address is self-relative)
;
;---
output:
	movq	@16(r11),r2		; Get descriptor of output buffer
	cmpw	(r1),r2			; Check if enough room in buffer
	bgtru	80$			; branch if buffer overflow
	movw	(r1),@20(r11)		; Store length of output string
	movc	(r1),@4(r1)[r1],(r3)	; store in output buffer
	incl	r0			; success
	brb	90$
80$:	movl	#ss$_bufferovf,r0	; set error
90$:	ret

	.sbttl	ERASE_PAGE	Erase to end of screen
;---
;
;	ERASE_PAGE
;
;	This routine causes the screen to be erased
;	from the specified position to the end of the
;	screen.  If the position is not specified, the
;	current screen position is assumed.
;
; Inputs:
;
;	 (AP)	= Number of arguments
;	4(AP)	= Line number (optional)
;	8(AP)	= Column number (optional)
;
;	If no arguments are specified, the current cursor
;	position is assumed.
;
;---
erase_page:
	tstb	(ap)			; Any arguments specified?
	bneq	10$			; Branch if so
	movaq	b^erase_table[r1],r1	; Address of output string
	brw	output
10$:
	cmpl	#2,r1			;ADM3A?
	bneq	15$			;If ne no
	cmpl	#1,4(ap)		;At Line 1?
	bneq	13$			;If ne no
	cmpl	#1,8(ap)		;At Col 1?
	beql	15$			;If eq yes
;
; Special case for ADM3A. If not 1,1 position erase, just move the cursor.
;
13$:
	movaq	b^ADM3A_erase_table,r1
	brw	pos_output
15$:
	movaq	b^erase_table2[r1],r1	; Output string with 2 args
	brw	pos_output

ADM3A_erase_table:
	string	<<esc><ADM3_sc>"!AC">
erase_table:				; ERASE TO END OF SCREEN
	string	<<esc><CP100_prm><esc><CP100_eos>>	; CP100
	string	<<esc><annarbor_eos>>			; annarbor
        string  <"">                   			; ADM3
	string	<<esc><lb><amb_eos>>			; ambassador
	string	<"">
	string	<"">
	string	<<esc><teleray_EOS>>			; teleray
	string  <"!!wor 30 h"<esc>"!!era">	;tek4027, define workspace first
erase_table2:				; ERASE FROM POSITION
	string	<<esc><CP100_prm><esc><cp100_sc>"!AC"<esc><cp100_eos>>; cp100
	string	<<esc><annarbor_sc>"!AC"<esc><annarbor_eos>>; annarbor
        string  <<ADM3_Home>>                   	; ADM3
	string	<<esc><lb>"!AC"<amb_sc>-		; ambassador
		<esc><lb><amb_eos>>
	string	<"">
	string	<"">
	string	<<esc><teleray_SC>"!AC"<esc><teleray_EOS>>  ; teleray
	string	<"!!wor 30 h"<esc>"!!jum!AC!!era"> ;tek4027

	.sbttl	ERASE_LINE	Erase to end of line
;---
;
;	ERASE_LINE
;
;	This routine causes the screen to be erased
;	from the specified position to the end of the
;	line.  If the position is not specified, the
;	current screen position is assumed.
;
; Inputs:
;
;	 (AP)	= Number of arguments
;	4(AP)	= Line number (optional)
;	8(AP)	= Column number (optional)
;
;	If no arguments are specified, the current cursor
;	position is assumed.
;
;---
erase_line:
	tstb	(ap)			; Any arguments specified?
	bneq	10$			; Branch if so
	movaq	b^line_table[r1],r1	; Address of output string
	brw	output
10$:
	movaq	b^line_table2[r1],r1	; Output string with 2 args
	brw	pos_output

line_table:				; ERASE TO END OF LINE
	string	<<esc><CP100_eol>> 			; cp100
	string	<"">					; annarbor
	string	<"">					; adm3
	string	<<esc><lb><amb_eol>>			; ambassador
	string	<"">
	string	<"">
	string	<<esc><teleray_EOL>>			; teleray
	string	<"!!dli">				; tek4027
line_table2:				; ERASE FROM POSITION
	string	<<esc><cp100_sc>"!AC"<esc><cp100_eol>>	; cp100
	string	<"">					; bor
	string	<<esc><ADM3_sc>"!AC">			; adm3
	string	<<esc><lb>"!AC"<amb_sc>-		; ambassador
		<esc><lb><amb_eol>>
	string	<"">
	string	<"">
	string	<<esc><teleray_SC>"!AC"<esc><teleray_EOL>>  ; teleray
	string	<"!!jum!AC!!dli">			; tek4027

	.sbttl	SET_CURSOR	Set cursor position
;---
;
;	SET_CURSOR
;
;	This routine causes the cursor to be moved to
;	to the specified position.
;
; Inputs:
;
;	4(AP)	= Line number
;	8(AP)	= Column number
;
;---
set_cursor:
	movaq	b^cursor_table[r1],r1	; Output string with 2 args
	brw	pos_output

cursor_table:				; SET CURSOR
        string  <<esc><cp100_sc>"!AC">,		; cp100
	string	<<esc><annarbor_sc>"!AC">	; annarbor
        string  <<esc><ADM3_sc>"!AC">   	; adm3
	string	<<esc><lb>"!AC"<amb_sc>>	; ambassador
	string	<"">
	string	<"">
	string	<<esc><teleray_SC>"!AC">
	string	<"!!jum!AC"<esc>>		;tek4027

	.sbttl	DOWN_SCROLL	Move cursor up, scrolling downward
;---
;
;	DOWN_SCROLL
;
;	This routine causes the cursor to be moved up
;	1 line to same column of the previous line.
;	If the cursor was on the top line to begin with,
;	it stays where it was, but all the information
;	on the screen appears to move down one line.
;	The information that was on the bottom line of
;	the screen is lost and a blank line appears at
;	the top.
;
; Inputs:
;
;	None
;
;---
down_scroll:
	movaq	b^scroll_table[r1],r1	; Output string with 2 args
	brw	output

scroll_table:				; DOWN SCROLL
	string	<<esc><CP100_dwn>>		; cp100
        string  <<esc><annarbor_dwn>>   	; annarbor
	string	<<ADM3_DWN>>			; adm3
	string	<<esc><amb_dwn>>	; ambassador
	string	<"">
	string	<"">
	string	<<esc><teleray_dwn>>		; teleray
	string	<"!!up">			; tek4027

	.sbttl	PUT_SCREEN	Write message to terminal
;---
;
;	PUT_SCREEN
;
;	This routine is used to write messages to the
;	terminal.
;
; Inputs:
;
;	4(AP) = Address of descriptor of output string
;	8(AP) = (optional) line number
;	12(AP) = (optional) column number
;	16(AP) = (optional) text attributes
;
;---
put_screen:
	cmpl	(ap),#1			; Check if only one argument
	bgtr	10$			; Branch if coords given
	movl	4(ap),r1		; Address of descriptor
	movq	(r1),-(sp)		; Copy descriptor to stack
	subl	sp,4(sp)		; and make self-relative
	movl	sp,r1			; Address of self-relative desc.
	brw	output
10$:
	pushl	4(ap)			; Optional fao argument
	addl	#4,ap			; Pass coords in 4(ap),8(ap)
	movaq	b^put_table[r1],r1	; Address of fao string
	brw	pos_output

PUT_TABLE:				; Write with embedded cursor
	string  <<esc><cp100_sc>"!AC!AS">	; cp100
	string	<<esc><annarbor_sc>"!AC!AS">	; annarbor
        string  <<esc><ADM3_sc>"!AC!AS">        ; ADM3
	string	<<esc><lb>"!AC"<amb_sc>"!AS">	; ambassador
	string	<"">
	string	<"">
	string  <<esc><teleray_sc>"!AC!AS">	; teleray
	string	<"!!jum!AC"<esc>"!AS">		; tek4027

	.sbttl	GET_SCREEN	Read input string from terminal
;---
;
;	GET_SCREEN
;
;	This routine accepts input from the terminal into
;	a user specified buffer.  An optional prompt string
;	may be given.
;
; Inputs:
;
;	4(AP) = Address of buffer descriptor
;	8(AP) = Address of prompt descriptor (optional)
;
;---
get_screen:
	callg	(ap),G^lib$get_input	; Read terminal input
	ret


	.end	dispatcher