COMMENT ⊗   VALID 00009 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	.TITLE DISP  - Display routines to do I/O from Pascal
C00004 00003	Here is the definition of the Terminal Characteristics slots:
C00007 00004	Misc routines: BEEP, INITSC, REINIT, RESETS, CLEARS & ECHO, ESCINI & ESCINT
C00014 00005	Cursor postioning routines: SHOWCU, RESTCU
C00018 00006	Line output routine: OUTLIN
C00026 00007	Character routines: GETCHAR, ANYCHAR & OUTCHAR
C00030 00008	"Smart Terminal" routines: INSCHAR, DELCHAR, INSLINE & DELLINE
C00034 00009	Aux routines:  GETLIN MOVCUR CVI OUTSTR OUTCHR GETCHR OUTST2 
C00039 ENDMK
C⊗;
.TITLE DISP  - Display routines to do I/O from Pascal

; MACRO definitions.

	.MCALL	QIOW$S,WTSE$S,CLEF$S,QIO$C,QIOW$C,ASTX$S,MRKT$S

.MACRO	PUSH X			
	.IRP Y,<X>		 
	MOV Y,-(SP)		 
	.ENDM
	.ENDM

.MACRO	POP X			
	.IRP Y,<X>		 
	MOV (SP)+,Y
	.ENDM
	.ENDM

;Here is the definition of the Terminal Characteristics slots:

TTHT	= 0	;Height of screen (number of lines)
TTCLRL	= 2	;What to type to clear to end of line
TTCLRS	= 4	;What to type to clear to end of screen
TTDELC	= 6	;Delete character
TTDELL	= 10	;Delete line
TTINSC	= 12	;Insert a character (may enter "insert mode")
TTINSL	= 14	;Insert line (won't enter insert mode)
TTINSX	= 16	;Cancel insert mode for char insert
TTBOLD	= 20	;Enter bold face mode
TTNORM	= 22	;Enter normal mode
TTCURP	= 24	;Position cursor
TTCURT	= 26	;Kind of cursor positioning req'd: 0="<l>;<c>H", 1=other

T1DAT:	.WORD	23. 		;TTHT
	.WORD	T1CLRL		;TTCLRL
	.WORD	T1CLRS		;TTCLRS
	.WORD	T1DELC		;TTDELC
	.WORD	T1DELL		;TTDELL
	.WORD	T1INSC		;TTINSC
	.WORD	T1INSL 		;TTINSL
	.WORD	T1INSX		;TTINSX
	.WORD	T1BOLD		;TTBOLD
	.WORD	T1NORM		;TTNORM
	.WORD	T1CURP		;TTCURP
	.WORD	0      		;TTCURT


.ENABL	LC	;Enable lowercase for the stuff below.

ESC = 33	;Escape character
LB  = 133	;Left bracket ([)

; Data for the Zenith terminal in ANSI mode:

T1CLRL:	.BYTE	ESC,LB,'K,0
T1CLRS:	.BYTE	ESC,LB,'H,ESC,LB,'J,0	;Go home first then clear
T1DELC:	.BYTE	ESC,LB,'P,0
T1DELL:	.BYTE	ESC,LB,'M,0
T1INSC:	.BYTE	ESC,LB,'4,'h,0
T1INSL:	.BYTE	ESC,LB,'L,0
T1INSX:	.BYTE	ESC,LB,'4,'l,0
T1BOLD:	.BYTE	ESC,LB,'7,'m,0
T1NORM:	.BYTE	ESC,LB,'m,0
T1CURP:	.BYTE	ESC,LB,'0,'0,';,'0,'0,'H,0

.EVEN
;Misc routines: BEEP, INITSC, REINIT, RESETS, CLEARS & ECHO, ESCINI & ESCINT

;procedure beep;
	PROC	BEEP		
	SAVE	R0
	BEGIN
	MOV	#7,R0		;Just type a BELL
	JSR	PC,OUTCHR
	ENDPR 


;function initScreen(lbase: listingarray): integer; 
	FUNC	INITSC,RES,INTEGER	
	PARAM	LBASE,ADDRESS
	SAVE	R1
	BEGIN
        MOV   	LBASE(SP),TBASE	;Remember base address of listing array
	JSR	PC,GETLIN	;Get our terminal's characteristics (returned in R1)
	MOV	R1,TERM		;Save terminal type (address of tty table)
	MOV	TTHT(R1),RES(SP)	;Return screen height from table
	ENDPR


;procedure reInitScreen;
	PROC	REINIT		
	BEGIN
        JSR	PC,CLEAR1	;Clear the screen
	ENDPR


;procedure resetScreen;
	PROC	RESETS		
	BEGIN
	JSR	PC,CLEAR1			;First clear screen
    	QIO$C	SF.SMC,5,3,,,,<SFDAT2,2>	;Reset tty characteristics
	ENDPR

;procedure clearScreen;
	PROC	CLEARS		
	BEGIN
	JSR	PC,CLEAR1
	ENDPR

CLEAR1:	PUSH	<R1,R5>		;Save registers we use
	MOV	TERM,R5		;Get tty descriptor address
	MOV	TTCLRS(R5),R1	;And find how to clear screen
	JSR	PC,OUTSTR	;Type the stuff
	POP	<R5,R1>
	RTS	PC

	
;procedure echo(on: boolean);
	PROC	ECHO
	PARAM	ON,BOOLEAN
	BEGIN
	;Nothing to do since we never echo anyhow!
	ENDPR


;procedure escInit(var flg: boolean);
	PROC	ESCINI
	PARAM	FLG,ADDRESS
	BEGIN
        MOV	FLG(SP),ESCFLG	;Get address of flag word;
;     Now attach the terminal to our task.  Upon reciept of a control-C,
;     control is passed to ESCINT.  Other characters are buffered by the
;     system and passed to the task when a IO.RAL is performed.
;       QIO$C	IO.ATA,5,3,,,,<CHRAST,,ESCINT>	;This is to do all with ast's
        QIOW$S	#IO.ATA,#5,#3,,,,<,,#ESCINT>	
;     Set terminal so it ignores control chars (like ↑O, ↑Q etc) and passes them
;     along to the task.
	QIO$C	SF.SMC,5,3,,,,<SFDAT1,2>	
	ENDPR

;Come here upon reciept of control-C from terminal...
ESCINT:	MOVB	#1,@ESCFLG	;Set flag when we get an escape-I interrupt
	TST	(SP)+		;Remove event flag# from stack
	ASTX$S     		;That's all we need to do


TBASE:	.WORD	0		;Location of listing base address
TERM:	.WORD	T1DAT		;Address of start of terminal data

SFDAT1:	.BYTE	TC.BIN,1	;Make terminal ignore control sequences
SFDAT2:	.BYTE	TC.BIN,0	;Make terminal recognize them again

ESCFLG:	.WORD	0		;Address of interrupt flag word

;Cursor postioning routines: SHOWCU, RESTCU

;procedure showCursor(line,col: integer);
	PROC	SHOWCU
	PARAM	LINE,INTEGER
	PARAM	COL,INTEGER
	VAR	CURADR,INTEGER
	SAVE	<R0,R1>
	BEGIN
	CMP	COL(SP),#80.	;check for line overflow
	BLE	5$		 ;no
	SUB 	#80.,COL(SP)	 ;yes - correct column number
	INC	LINE(SP)	 ; & bump line number
5$:     MOV	LINE(SP),R0	;Set up line and column for cursor addr
	MOV	COL(SP),R1
	JSR	PC,MOVCUR
	MOV	LINE(SP),CULINE	;Save where we moved to 
	MOV	COL(SP),CUCOL
	ENDPR
 

CULINE:	.WORD	1		;Previous line
CUCOL:	.WORD	1		;and column


RESTCU:	PUSH	<R0,R1>		;Restores cursor to position saved above
	MOV	CULINE,R0
	MOV	CUCOL,R1
	JSR	PC,MOVCUR
	POP	<R1,R0>
	RTS	PC

;Line output routine: OUTLIN

;procedure outLine(line,col,start,length: integer);
	PROC	OUTLINE
	PARAM	LINE,INTEGER	;Line and column output is to start at
	PARAM	COL,INTEGER	
	PARAM	START,INTEGER	;Start of text in buffer
	PARAM	LENGTH,INTEGER	;How much text to display.
	VAR	TEMP,INTEGER	;Work variable
	SAVE	<R0,R1,R5>
	BEGIN
	TST	LENGTH(SP)	;Make sure # chars to print > 0
	BLE	100$		 ;else nothing to do
    	MOV	TERM,R5		;Terminal descriptor addr in R5
    	MOV	LINE(SP),R0	;Set up for cursor positioning
	MOV	COL(SP),R1
	JSR	PC,MOVCUR	;move cursor to initial position
	MOV	LENGTH(SP),R0	;Compute col + length ( + 1)
	ADD	COL(SP),R0
	CMP	R0,#81.		;Make sure line won't be too long
	BLE	5$		 ;Nope - we're ok.  It fits on one line
        CMP	COL(SP),#80.	 ;Line too long.  OK if col > 80.
	BGT	5$
	MOV	#81.,TEMP(SP)	;Find number of chars that fit on 1st line
	SUB	COL(SP),TEMP(SP)    
    	MOV	START(SP),R1    ;Get offset of first char to write
	ADD	TBASE,R1	;Array base address + offset = start addr
	MOV	TEMP(SP),R0	;Type this number of chars on 1st line
	JSR	PC,OUTST2	;Type the string
	MOV	COL(SP),R0	;See if we can clear end of line. Does line extend
	ADD	TEMP(SP),R0	 ;all the way to the end?
	CMP	R0,#81.		;If < 81, we can clear it.
	BGE	3$		 ;Otherwise don't since that'd erase last char.
	MOV 	TTCLRL(R5),R1	;and clear rest of line too
	JSR	PC,OUTSTR
3$:	ADD	TEMP(SP),START(SP)	;Update starting place in buffer
	SUB	TEMP(SP),LENGTH(SP)	;And use how many chars overflowed.
   	MOV	LINE(SP),R0	;Position cursor for overflow line
	INC	R0		 ; (it's on the next line)
	MOV	#1,R1        	;Put it in the 1st column
	JSR	PC,MOVCUR
5$:	MOV	START(SP),R1	;Now get starting addr of string to type
	ADD	TBASE,R1	;Array base address + offset = start addr
	MOV	LENGTH(SP),R0	;Move number of chars to print to R0
	JSR	PC,OUTST2	;Type the string
	MOV	COL(SP),R0	;See if we can clear end of line. Does line extend
	ADD	LENGTH(SP),R0	 ;all the way to the end?
	CMP	R0,#81.		;If < 81, we can clear it.
	BGE	10$		 ;Otherwise don't since that'd erase last char.
	MOV 	TTCLRL(R5),R1	;and clear rest of line too
	JSR	PC,OUTSTR
10$:	JSR	PC,RESTCU	;Finally, restore cursor to previous position
100$:	ENDPR

;Character routines: GETCHAR, ANYCHAR & OUTCHAR

;function getChar: ascii;
	FUNC	GETCHAR,RES,CHAR
	SAVE	R0
	BEGIN
	JSR	PC,GETCHR		;Read one char, don't echo it.
	MOV 	R0,RES(SP)		;Return char
	ENDPR


;function anyChar(var ch: ascii): boolean;
	FUNC	ANYCHAR,RES,BOOLEAN
	PARAM	CH,ADDRESS
	VAR	BUFFER,INTEGER
	SAVE	R0
	BEGIN
	CLRB	@CH(SP)				;Clear result (assume no char)
	CLR	RES(SP)				;Assume no char - clear flag
    	QIOW$C	SF.GMC,5,17.,,,,<CHRDAT,2>	;Get terminal characteristics.
	TSTB	CHRDAT+1			;Any chars waiting?
	BEQ	15$				 ;No - Exit with results already set
	JSR	PC,GETCHR			 ;Yes - Read char & put in R0.
	MOVB	R0,@CH(SP)			;Return result in VAR param.
	MOV	#1,RES(SP)			;Indicate we got a char.
15$:	ENDPR

CHRDAT:	.BYTE	TC.TBF,0	;Get type-ahead buffer count in hi byte


;procedure outChar(line,col: integer; ch: ascii; bold: boolean);
	PROC	OUTCHAR
	PARAM	LINE,INTEGER	;Line and column to put char
	PARAM	COL,INTEGER
	PARAM	CH,CHAR		;The char to write
	PARAM	BOLD,BOOLEAN	;Nonzero means type it in boldface
	SAVE	<R0,R1,R5>
	BEGIN
	MOV	TERM,R5		;TTY info address
	MOV	LINE(SP),R0	;Get ready for cursor setup
	MOV	COL(SP),R1
	JSR	PC,MOVCUR	;Move cursor to initial position
	TSTB	BOLD(SP)	;Bold face output?
	BEQ	5$		 ;No - don't do it.
	MOV	TTBOLD(R5),R1	;Type stuff to make next char bold face
	JSR	PC,OUTSTR
5$:  	MOVB	CH(SP),R0	;Stick char to write into R0
	JSR	PC,OUTCHR
	TSTB	BOLD(SP)	;Did we type the char in bold face?
	BEQ	10$		 ;No - we're done
	MOV	TTNORM(R5),R1	;Make next char normal
	JSR	PC,OUTSTR
10$:	ENDPR

;"Smart Terminal" routines: INSCHAR, DELCHAR, INSLINE & DELLINE

;procedure insChar(line,col: integer; ch: ascii); 
	PROC	INSCHAR
	PARAM	LINE,INTEGER
	PARAM	COL,INTEGER
	PARAM	CH,CHAR
	SAVE	<R0,R1,R5>
	BEGIN
	MOV	TERM,R5		;Address of terminal data block
	MOV	LINE(SP),R0	;Move cursor to place to insert a char
	MOV	COL(SP),R1	
	JSR	PC,MOVCUR
	MOV	TTBOLD(R5),R1	;Put terminal in Bold mode
	JSR	PC,OUTSTR
	MOV	TTINSC(R5),R1	;Get what to type to insert a char
	JSR	PC,OUTSTR	;and type it
	MOVB	CH(SP),R0
	JSR	PC,OUTCHR
	MOV 	TTINSX(R5),R1	;Cancel insert mode
	JSR	PC,OUTSTR
	MOV	TTNORM(R5),R1	;and go back to normal mode (not bold)
	JSR	PC,OUTSTR
	ENDPR

;procedure delChar(line,col: integer); 
	PROC	DELCHAR
	PARAM	LINE,INTEGER
	PARAM	COL,INTEGER
	SAVE	<R0,R1,R5>
	BEGIN
	MOV	TERM,R5		;Address of terminal data block
	MOV	LINE(SP),R0	;Get ready for cursor setup
	MOV	COL(SP),R1
	JSR	PC,MOVCUR	;Move cursor to initial position
	MOV 	TTDELC(R5),R1	;Type stuff to delete one char
	JSR	PC,OUTSTR
	ENDPR

;procedure insLine(line,num: integer); 
	PROC	INSLINE
	PARAM	LINE,INTEGER
	PARAM	NUM,INTEGER
	SAVE	<R0,R1,R2,R3,R5>
	BEGIN
	MOV	TERM,R5		;Address of terminal data block
	MOV	LINE(SP),R0	;Get ready for cursor setup
	MOV	TTINSL(R5),R2	;What to type to insert a line
	MOV	NUM(SP),R3	;Save number of lines to insert
	JSR	PC,DOID		;Do insert or delete
	ENDPR

;procedure delLine(line,num: integer); 
	PROC	DELLINE
	PARAM	LINE,INTEGER
	PARAM	NUM,INTEGER
	SAVE	<R0,R1,R2,R3,R5>
	BEGIN
	MOV	TERM,R5		;Address of terminal data block
	MOV	LINE(SP),R0	;Save line# for cursor setup
	MOV	TTDELL(R5),R2	;What to type to delete a line.
	MOV	NUM(SP),R3	;Save number of lines to delete
	JSR	PC,DOID
	ENDPR


;Enter DOID with 
;   R0 = Line# to start at 
;   R2 = Addr of cmd from terminal table
;   R3 = Number of lines to insert/delete
;   R5 = Addr of terminal data block.

DOID:	TST	R3		;Anything to do?
	BLE	10$		 ;(if none all done)
	PUSH	R3		;Remember how many lines
	MOV	#1,R1		;Move cursor to column 1 (line# already set up)
    	JSR	PC,MOVCUR	;Set up position
5$:	MOV	R2,R1		;Set up to type insert/delete command
	JSR	PC,OUTSTR	;Type stuff to insert or delete 1 line
     	SOB	R3,5$		;Repeat till done
	JSR	PC,RESTCU	;Restore cursor position
	POP	R3		;Get back how many lines we inserted/deleted
	ASH	#3,R3		 ;multiply by 8 to get # of ticks to wait
      	MRKT$S	#4,R3,#1	 ;(each is ~16 msec) so wait .128 sec per line
	WTSE$S	#4		;(wait for event flag to be set)
10$:	RTS	PC

;Aux routines:  GETLIN MOVCUR CVI OUTSTR OUTCHR GETCHR OUTST2 

GETLIN:	MOV	#T1DAT,R1	;Only 1 kind of terminal now
	RTS	PC


; "MOVCUR" moves the cursor to the address on the screen specified by R0 and R1,
; where R0=line and R1=column.  R5 must point to the terminal data block.
; R0 and R1 may be changed.
MOVCUR:	PUSH	R2
	MOV	#IOBUF+2,R2	;Start string conversions here.
	INC	R0		;AL thinks they start at 0 but really 1...
	CMP	R1,#81.		;Line overflow?  
	BLT	5$		 ;If not, continue
	INC	R0		 ;Yes - go to next line
	SUB	#80.,R1      	  ;and adjust column # also
5$:	JSR	PC,CVI		;Convert Line# to decimal
	MOVB	#';,(R2)+	;Put in delimeter
	MOV	R1,R0		;Now do the column
	JSR	PC,CVI
	MOVB	#'H,(R2)+	;Code to position cursor
	CLRB	(R2)		;and null for end of string
	MOV	#IOBUF,R1	;Now type it
	JSR	PC,OUTSTR
	POP	R2
	RTS	PC	


; "CVI" converts a number (in R0) into a digit string starting at (R2).
CVI:	PUSH	R1      	;SAVE REGISTER
	JSR	PC,5$		;Go form number string recursively.
	POP	R1		;RESTORE REGISTERS
	RTS	PC		;ALL DONE
5$:   	MOV	R0,R1		;POSITION NUMBER FOR DIVISION
       	CLR	R0		;CLEAR FOR DIVISION
	DIV	#10.,R0		;GET LSD
	ADD	#'0,R1		;OR ASCII BASE
	MOVB	R1,-(SP)	;SAVE DIGIT
	TST	R0		;Are we done?
	BEQ	10$		 ;Yes - Store digits
	JSR	PC,5$   	;REPEAT RECURSIVELY
10$:	MOVB	(SP)+,(R2)+	;PUT DIGITS IN STRING
	RTS	PC


; "OUTSTR" outputs an ASCIZ string, which ends with a zero character.  
; A pointer to the start of the string must be loaded into R1.
; If the length of the string is already known, call OUTST2 with R1 pointing
; to the string and R0 containing the length.
; Nothing is changed.

OUTSTR:	PUSH	<R0,R1>		;Types using WAL
	CLR	R0		;Figure out how long the string is
5$:	TSTB	(R1)+		;End of string?
	BEQ	10$		 ;Yes. Type it now
	INC	R0
	BR	5$
10$:	POP	R1		;Restore R1 to point to string beginning
	JSR	PC,OUTST2	;Go type the string.
	POP	R0		;and restore R0
	RTS 	PC		;Done

; "OUTCHR" prints the character in R0.  Nothing is changed.
OUTCHR:	PUSH	<R0,R1>		;Save registers we use
	MOVB	R0,CHBUF    	;Move char to type to core memory
	MOV	#CHBUF,R1	;Set up for OUTST2:  Addr of string beginning
	MOV	#1,R0		;and number of chars to type
	JSR	PC,OUTST2	;go type the single char
	POP	<R1,R0>		;and restore registers
	RTS	PC


; "GETCHR" reads a character without echoing and returns it in R0.
GETCHR:	QIOW$S	#IO.RAL!TF.RNE,#5,#17.,,,,<#CHBUF,#1>	
 	MOVB	CHBUF,R0	;and store result
	BIC	#↑O<177600>,R0	;Clear parity & upper 8 bits.
	RTS	PC

; Auxilliary routine to print a string.  R1=address, R0=length.
OUTST2: QIOW$S	#IO.WAL,#5,#17.,,,,<R1,R0>	;Type the characters.
	RTS	PC


IOBUF:	.BYTE	ESC,LB, 0,0, 0,0, 0,0, 0,0, 0,0	;For positioning cursor
CHBUF:	.WORD	0

.END