.MCALL .MODULE .MODULE VIDEO,VERSION=69,COMMENT= ; 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. .SBTTL Local definitions .PSECT PIDVR ;+ ;The following four words are the possible operation classes available ;when generating a command through the CSR (VD$CSR). At initialization ;the color map enable bit (VDCME$) may be set in these words if the ;extended bitmap option is present. ;- VDMBLC:: .WORD VDMBL$ ;Bits left to right command VDMBTC:: .WORD VDMBT$ ;Bits top to bottom command VDMWLC:: .WORD VDMWL$ ;Words left to right command VDMWRC:: .WORD VDMWR$ ;Words right to left command VD$SLT:: .WORD 174400 ;Contains the address of controller CLRPAT:: .WORD 0 ;Clear pattern (depends on plane register) PLCONV: .BYTE VDMRE$!VDSNP$,VDMRE$!VDSRP$ ;Plane control for current ; display in low byte the other ; in the high byte CHRHIG:: .WORD 10. ;Number of pixels high per character CHRWID:: .WORD 12. ;Number of pixels wide per character SCRBOT:: .WORD <*CHRTMP> ;Y coordinate of bottom visible row SCNLIN:: .WORD ;# of scan lines for visible rows ROWWRD:: .WORD ;# of words in row of characters MLISL:: .WORD 256. ;Memory length in scan lines MAXCOL:: .WORD 79. ;Number of columns (0 bias) SCLMSK:: .WORD 177400 ;Mask of bits to clear before storing in ; scrolling register (240 line mode) PXLRAD:: .WORD ;Address of line to move PXLLPC:: .WORD ;Number of words in line to move (LOOP COUNT) WDCHNK:: .WORD ;Number of 32 word chunks in one printable row EBPTR:: .WORD ESCBUF ;Pointer to current position in escape buffer EBPTRE:: .WORD 0 ;Address of byte after end of esc. parm. buf. DEFBUF:: .WORD ESCDEF ;Address of start of defualt flag buffer CURCOL:: .WORD 0 ;Current column number CURROW:: .WORD 0 ;Current row number .SBTTL Characteristics byte flag ;+ ;Character attributes. ;- D$BLNK::.WORD RESET ;Blink character attribute .BR D$BOLD D$BOLD::.WORD RESET ;Bold character attribute .BR D$UNDR D$UNDR::.WORD RESET ;Underscore character attribute .BR D$REVR D$REVR::.WORD RESET ;Reverse character attribute ;+ ;Modes. ;Set is 1. Reset is 0. ;- D$ATT:: .BYTE RESET ;Low 4 bits are character attributes D$SSI:: .BYTE RESET ;Single shift in 2 and 3 flag byte ; 0 = no single shift in ; 1 = single shift in 2 ; 2 = single shift in 3 ;High 4 bits are line attributes D$SISO::.BYTE RESET ;Shift in/Shift out state ;<> = shift out ;0 = shift in DECMOD::.BYTE 0 ;Status mode for DEC mode character (?) ;If <> question mark encountered ESCPRO::.BYTE 0 ;<> escape sequence processing in progress ESCTYP::.BYTE 0 ;Escape sequence type (DCS, CSI, or ST) ESCEND::.BYTE 0 ;Flag set possible end of control string seq QFLAG:: .BYTE 0 ;Question mark flag for CSI sequence KB$OFF::.BYTE 0 ;XON/XOFF flag byte ; 0 - XON ; 1 - XOFF first character ;-1 - XOFF after first character .EVEN ESCERR::.WORD 0 ;Error in escape sequence flag ESCBUF::.BLKB MAXPAR ;Buffer for storing escape sequence ESCBEN:: ;End of buffer .BR ESCDEF ;Must follow end of parameter buffer ESCDEF::.BLKB MAXPAR ;Set of default flags corresponding to ESCBUF ;(See ESCLBR routine). .EVEN RPLYBF::.BYTE ESC,'[ ;Preliminary characters for reply .BLKB 18. ;Buffer area to store replies S$DRP2::.ASCII /[>/ .IF EQ MMG$T ;If not XM .ASCII /7/ ; FB (without 132 column support) .IFF ;IF XM .ASCII /8/ ; XM (with 132 column support) .ENDC ;NE MMG$T .ASCII /;/ .MCALL ...CMV ...CMV PART=RELEASE,TYPE=I ...CMV PART=VERSION,TYPE=I .ASCIZ /c/ TTOK: .ASCIZ /[0n/ .EVEN VDFORK::.WORD 0,0,0,0 ;FORK block for video .SBTTL Entry points ;+ ;General entry point information: ;The video portion of the Professional interface has two seperate entry ;points. The first one is PUTCHR. PUTCHR is entered when there is a ;character in RT's ring buffer that must be processed. The second entry ;point is VDCURS. VDCURS is entered on end of frame interrupt. The end ;of frame interrupt is used as a tick counter for cursor blink, smooth ;scroll, and counter for screen black-out. ;+ .SBTTL PUTCHR - Character in ring buffer entry point ;+ ;PUTCHR ;Entry point for processing characters. If escape sequence processing is not ;in progress parse the character through the control character list (less ;than 40). If greater or equal to 40 (space) display the character on the ;screen. ; ;If escape sequence processing is in progress determine if the character ;in R0 is to be used as the sequence type determinator. If the type has ;been determined then treat the character as part of the sequence and ;process as appropriate. ;+ .ENABL LSB PUTCHR:: MOV VD$SLT,R5 ;Get controller register for slot MOV #,(PC)+ ;Set number of heart beats BYESCR:: .WORD 0 ;Number of EOF till display turn off MOV SP,(PC)+ ;Indicate that we are in a critical region PRIO0:: .WORD 0 BIT #,VD$CSR(R5) ;Is transfer done interrupt enabled? BEQ 5$ ;Branch if not MOV #<100000>,(PC)+ ;Remember to turn interrupts back on later REENAB:: .WORD 0 BIC #,VD$CSR(R5) ;Turn off transfer done interrupts 5$: .FORK VDFORK ;Must FORK to give KB processing a chance MOV SP,(PC)+ ;Save SP to assist context switches SAVESP: .WORD 0 .IF NE MMG$T ;If XM TST (PC)+ ;Are we already in text mode? VIDMOD:: .WORD 0 ;0 => text mode; non-0 => GIDIS mode BEQ 10$ ;Branch if already in text mode CLR VIDMOD ;Say we are now in text mode CALL MAPKBD ;Map TXTMOD routine CALL @#TXTMOD ;Do a video register context switch $REL .-2,TXTMOD,PIK CALL STPCUR MOV #1,R3 ;Enable CALL DECTCE ; cursor 10$: CALL MAPVD ;Map to PIV region via kernel PAR1 .ENDC ;NE MMG$T ; CLR CHRFET ;Set character processing in progress 15$: TST VD$CSR(R5) ;Video done? BPL 15$ ;Loop if no MOV VD$Y(R5),ROWYCO ;Use the Y coordinate for scrolling MOVB VIDBUF,R0 ;Get character from byte buffer BIC #^C<177>,R0 ;Strip unnecessary bits BEQ 75$ ;Branch if null MOV PLCONV,VD$P1C(R5) ;Set up plane 1 control CMPB R0,# ;Space character or higher? BHIS 20$ ;Possible normal character CALL CTRL ;Process for control character BR 75$ ;Get next character 20$: TSTB ESCPRO ;Escape sequence in process? BEQ 35$ ;Branch if not - Treat as normal character CALL SCWAIT ;Wait until scrolling is done TSTB ESCTYP ;Has the escape sequence type been determined? BNE 30$ ;Branch if yes CALL SEQTYP ;No, determine the type with this character BR 75$ 30$: CALL SEQDIS ;Dispatch to appropriate sequence processor BR 75$ 35$: CMP #,R0 ;Delete character? BEQ 75$ ;Branch to ignore if yes CALL STPCUR ;Stop cursor blink MOV (PC)+,R4 ;Get current character set CHRSET:: .WORD US$SET ;Current character set TSTB D$SSI ;Single shift in 2 or 3 in effect? BEQ 45$ ;Branch if no MOVB A$G2,R4 ;Assume single shift in 2 get G2 character set CMPB D$SSI,R4 ;Is it single shift in 2? BEQ 40$ ;Branch if yes, test to join common routine MOVB A$G3,R4 ;Get character set in G3 40$: CLRB D$SSI ;Initialize the single shift in/out byte flag 45$: ASL R4 ;Shift character set number into proper place BISB D$ATT,R4 ;Get renditions SWAB R4 ;Put assembled bits in high order byte BISB R0,R4 ;Put ASCII character in low byte .BR STRCEL ;+ ;Store cell word in the character cell. ;- STRCEL: TST EOLFLG ;Are we up against the wall mom? BEQ 55$ ;No my son TSTB D$AWM ;Auto wrap mode set? BEQ 55$ ;Branch if no MOV R4,-(SP) ;Save character cell entry CALL SCROLL ;Scroll if needed (update row) MOV VD$Y(R5),ROWYCO ;Use the Y coordinate for scrolling CLR CURCOL ;Reset current column number CLR VD$X(R5) ;Reset x register CLR EOLFLG ;Reset end of line flag MOV (SP)+,R4 ;Restore character cell entry CALL SCWAIT ;Wait until scrolling is done 55$: MOV CURROW,R0 ;Get current row number ASL R0 ;Make it an offset MOV CELSTR(R0),R1 ;R1 -> Start of character cell vector table $REL .-2,CELSTR,PIV MOV CURCOL,R2 ;Get real current column BIT #,LINCEL(R0) ;Double wide line? $REL .-2,LINCEL,PIV BNE 60$ ;Yes, don't adjust offset (effective 1/2) ASL R2 ;Make current column an offset 60$: ADD R2,R1 ;R1 -> Character cell for current character MOV R4,@R1 ;Store the character cell entry into buffer TSTB S$MARB ;Margin bell flag set? BEQ 70$ ;Branch if no MOV #<79.-8.>,-(SP) ;Assume 80 column mode .IF NE MMG$T ;If XM TSTB D$COLM ;80 or 132 column mode? BEQ 65$ ;Branch if 80 column mode MOV #<131.-8.>,@SP ;Set margin bell column for 132 column mode .ENDC ;NE MMG$T 65$: CMP CURCOL,(SP)+ ;Are we at the margin bell column? BNE 70$ ;Branch if no CALL SPCBEL ;Call routine to ring the bell 70$: CALL DSPCHR ;Display character CALL CURCTL ;Call the cursor control routine 75$: ; TST SCROCT ;Any scan lines been scrolled out? ; BEQ 80$ ;Branch if no ; CALL SMOSCL ;Yes, clear them ; MOV ROWYCO,VD$Y(R5) ;Update the y coordinate with real one ;80$: MOV SP,(PC)+ ;Set <> equal to denote note character process ;CHRFET: .WORD 1 ;Character in process flag UNLTXT::MOVB #PR4,@#PS ;Go to priority 4 ASL REENAB ;Clear flag BCC 85$ ;Branch if it was already cleared BIS #VDDIE$,VD$CSR(R5) ;Generate a transfer done interrupt 85$: CLR PRIO0 ;Indicate we have left a critical region CLRB @#PS ;Go to priority 0 RETURN .DSABL LSB SCWAIT: CALL WAIT ;Wait until scrolling is finished CMP ROWYCO,SCRBOT ;Scrolling in progress? BGT 1$ ;If so, branch to wait TST (PC)+ ;Say we don't need to wait 1$: SEC ;Indicate we're in a wait state RETURN .SBTTL VDCURS - End of frame entry point ;+ ;VDCURS ;Entered on every end of frame interrupt. Used for ticks for smooth ;scrolling, cursor blink, and screen blank. ;- .ENABL LSB VDCURS:: JSR R5,@#$INTEN ;Lower processor priority $REL .-2,$INTEN,RMON .WORD ^C&PR7 ; to priority 4 MOV SP,(PC)+ ;Signal an interrupt is pending INTPND: .WORD 0 ;Interrupt pending flag TST (PC)+ ;Are we blocked from running? VDLOCK: .WORD 0 ;VDCURS blocked flag BNE 7$ ;Branch if yes CLR INTPND ;Signify that there are no interrupts pending JSR R3,SAVE30 ;Save R0 through R3 MOV VD$SLT,R5 ;Get controller register for slot ;+ MOV VD$CSR(R5),(PC)+ $VDCSR: .WORD 0 MOV $VDPAT,(PC)+ $$VPAT: .WORD 0 ;- SCLCHK::CMP SCRBOT,(PC)+ ;Current position below visible area? ROWYCO:: .WORD 0 ;Current Y coordinate position BGE 5$ ;Branch if not scrolling MOV D$SCLM,-(SP) ;Smooth or jump scroll? ;-1 Smooth scroll forward (-2 in 480 mode) ;1 Smooth scroll backward (2 in 480 mode) ;0 Jump scroll BEQ 4$ ;Branch if jump scroll ADD @SP,ROWYCO ;New Y-coordinate BIC SCLMSK,ROWYCO ;Handle overflow ADD @SP,(PC)+ ;Update saved VD$Y S1VD$Y: .WORD 0 BIC SCLMSK,S1VD$Y ;Handle overflow ADD @SP,(PC)+ ;Update saved VD$Y S2VD$Y: .WORD 0 BIC SCLMSK,S2VD$Y ;Handle overflow ADD @SP,(PC)+ ;Update saved VD$Y S3VD$Y: .WORD 0 BIC SCLMSK,S3VD$Y ;Handle overflow ADD @SP,(PC)+ ;Update saved VD$Y S4VD$Y: .WORD 0 BIC SCLMSK,S4VD$Y ;Handle overflow MOV VD$SCL(R5),-(SP);Get current scroll register contents SUB 2(SP),@SP ;Update BIC SCLMSK,@SP ;Remove extraneous bits 1$: TST VD$CSR(R5) ;Video done? BPL 1$ ;No, wait until it is MOV (SP)+,VD$SCL(R5);Scroll up or down ADD @SP,(PC)+ ;Update scrolling count for clearing SCROCT:: .WORD 0 ;Number of scrolled out lines to clear ADD VD$Y(R5),@SP ;Update Y coordinate BIC SCLMSK,@SP ;Handle overflow CALL SMOSCL ;Do smooth scroll/clear line 3$: MOV @SP,VD$Y(R5) ;Update the Y coordinate 4$: TST (SP)+ ;Clean up stack before returning BR 6$ 5$: TST VDFLAG ;Is video buffer empty BNE 6$ ;Branch if not .IF NE MMG$T ;If XM CALL MAPVD ;Map to PIV region via kernel PAR1 .ENDC ;NE MMG$T CALL CURCT1 ;Update cursor 6$: ;+ MOV $VDCSR,VD$CSR(R5) MOV $$VPAT,$VDPAT MOV $$VPAT,VD$PAT(R5) ;- TST CNTXST ;Is character display waiting? BEQ 7$ ;Branch if not ASL FRKING ;Clear FRKING (Say fork block is in use) BCC 7$ ;Branch if somebody beat us to it .FORK VDFORK ;FORK to allow interrupts BR WAKEUP ; and go wake up the waiter 7$: RETURN .DSABL LSB .ENABL LSB WAIT: MOV @SP,WAICND ;Save pointer to wait condition code CALL @(SP)+ ; and see if we still need to wait BCC 3$ ;Branch if we are through waiting MOV R0,-(SP) ;Save R0 MOV #CNTXST+2,R0 ;Point to context stack $REL .-2,CNTXST+2,PI MOV (SP)+,(R0)+ ;Push R0 MOV R1,(R0)+ ;Save remainder of critical registers MOV R2,(R0)+ MOV R3,(R0)+ MOV R4,(R0)+ MOV R5,(R0)+ 1$: MOV (SP)+,(R0)+ ;Save a word from kernel stack CMP SP,SAVESP ;Are we done saving stack? BNE 1$ ;Branch if not .IF NE MMG$T MOV @#KISAR1,(R0)+ ;Save kernel PAR1 mapping MOV #200,@#KISAR1 ; and restore it to pre-FORK state .ENDC ;NE MMG$T MOVB #PR4,@#PS ;Lock out interrupts MOV R0,CNTXST ;Save top of context stack WAKEUP: MOVB #PR4,@#PS ;Lock out interrupts MOV #100000,FRKING ;Say fork block is free now CALL @WAICND ;Do we still need to wait? BCC 4$ ;Branch if we're through waiting CLRB @#PS ;Allow interrupts again 3$: RETURN ;Return from FORK level 4$: MOV CNTXST,R0 ;Get top of context stack CLR CNTXST ;Tell VDCURS we're not in wait state CLRB @#PS ;Allow interrupts again .IF NE MMG$T MOV -(R0),@#KISAR1 ;Restore kernel PAR1 .ENDC ;NE MMG$T 5$: MOV -(R0),-(SP) ;Restore word to kernel stack CMP R0,#CNTXST+14. ;Are we through restoring stack? $REL .-2,CNTXST+14.,PI BNE 5$ ;Branch if not MOV -(R0),R5 ;Restore registers MOV -(R0),R4 MOV -(R0),R3 MOV -(R0),R2 MOV -(R0),R1 MOV -(R0),R0 ;Restore R0 RETURN ;All done with waiting! .DSABL LSB WAICND: .WORD 0 ;Pointer to wait condition routine FRKING: .WORD 100000 ; 0 = fork block in use ;100000 = fork block free CNTXST: .WORD 0 ;Context switch top-of-stack pointer .REPT 39. ;Context switch stack .WORD 125252 .ENDR .ENABL LSB CURCTL: CALL LOCKVD ;Lock out VDCURS for awhile CURCT1: TST CURGO ;Blink cursor disabled? BEQ 1$ ;Branch if no MOVB #3,CURSCT ;Set new count CLR CURGO ;Reset to allow blink 1$: DECB CURSCT ;Decrement cursor count BGT 2$ ;No need to blink cursor CALL BLICUR ;Yes go blink 2$: RETURN ;Enable VDCURS and return to caller .DSABL LSB .ENABL LSB LOCKVD: MOV SP,VDLOCK ;Lock out VDCURS CALL @(SP)+ ;Call code that requires VDCURS locked out MOVB #PR4,@#PS ;Inhibit interrupts CLR VDLOCK ;Indicate that VDCURS can run now TST INTPND ;Did VDCURS try to run while we locked it? BEQ 1$ ;Branch if not MOV (PC)+,@(PC)+ ;Cause an end-of-frame interrupt VDIRQA:: .WORD 132 ;Installation code ors in slot # to this ; .WORD 130 ;Installation code ors in slot # to this .WORD 173206 ;Interrupt controller 1 command register 1$: CLRB @#PS ;Allow interrupts RETURN .SBTTL DSPCHR - Display a character ;+ ;DSPCHR ;The following is the main routine to display a character. On entry, the ;current character (R1 points to the character cell containing the current ;character entry) is compared with the previously displayed character ;(PRVCHR). If they are equal (including renditions and character set) it ;is assumed that the expanded character fonts are in the temporary buffer ;and the character is just displayed from that buffer. ; ;If the previous and current character cells do not match, then the character ;attributes are stored in the 4 attribute flag words. The line rendition is ;store in a flag word, and the temporary character buffer is cleared. The ;number of pixel lines (words for character pixels) is 10. (CBUFSZ) and does ;not depend on the the terminal mode (240 vs. 480). If the character is space ;set up the rendition of the character else store the pixel scan lines into ;the temporary buffer. ; ;Once the pixel scan lines have been stored and attributes have been handled ;display the contents of the buffer. ; ;Enter: R1 -> current character cell entry ; R5 = controller register for video slot ; ;Call: CALL DSPCHR ;Go display the character ; ;Exit: R5 = controller register for video slot ;- .ENABL LSB DSPCHR::MOV #CURCHR,R0 ;R0 -> temporary character table $REL .-2,CURCHR,PIV 5$: CMP @R1,(PC)+ ;Is current character the same as previous? PRVCHR:: .WORD 0 ;Contains previous printable character BEQ 20$ ;Branch if the same character MOV R0,-(SP) ;Save start of temporary character buffer MOV @R1,PRVCHR ;Store new previous character CALL SETATT ;Set attribute flag words for further process MOV CURROW,R4 ;Get current row number ASL R4 ;Make it an offset MOV #,R2 ;Set up loop for clear MOV LINCEL(R4),(PC)+ ;Store the current line cell $REL .-2,LINCEL,PIV LINREN:: .WORD 0 ;Contains the current line attributes BIC #^C,LINREN ;Isolate the line attributes BEQ 10$ ;Branch if no ADD #,R2 ;Add more to loop count to clear both buffers 10$: CLR (R0)+ ;Initialize buffer SOB R2,10$ ;Loop until done CMPB #,@R1 ;Displaying a space character? BEQ 15$ ;Branch if yes CALL GETSCL ;Get and store scan lines TST LINREN ;Double character processing? BEQ 15$ ;Branch if no CALL DOUBLE ;Go do doubling 15$: MOV @SP,R0 ;Point to start of temporary character buffer CALL SETREN ;Set the rendition MOV (SP)+,R0 ;Point to start of temporary character buffer MOV VD$SLT,R5 ;Get controller register for slot 20$: BIC #,VD$CSR(R5) ;Clean out writable bits BIS VDMBLC,VD$CSR(R5) ;Set bit left to right command into CSR TST LINREN ;Are we doubling the character BEQ 25$ ;Branch if single width CALL 25$ ;If yes display twice as much 25$: MOV #,R2 ;Get scan line count 30$: TST VD$CSR(R5) ;Test transfer done BPL 30$ ;Branch until done BIT #,VD$CSR(R5) ;240 or 480 line mode? BEQ 40$ ;Branch if 240 ;+ MOV @R0,(PC)+ $VDPAT: .WORD 0 ;- MOV @R0,VD$PAT(R5) ;Load the pattern into the register MOV CHRWID,VD$CNT(R5) ;Load the count INC VD$Y(R5) ;Set the y coordinate to the next line 35$: TST VD$CSR(R5) ;Test transfer done BPL 35$ ;Branch until done 40$: ;+ MOV @R0,$VDPAT ;- MOV (R0)+,VD$PAT(R5) ;Load the pattern into the register MOV CHRWID,VD$CNT(R5) ;Load the count INC VD$Y(R5) ;Set the y coordinate to the next line SOB R2,30$ ;Loop through all of character's scan lines SUB CHRHIG,VD$Y(R5) ;Reset Y coordinate CMP CURCOL,MAXCOL ;Displayed character in last line? BHIS 45$ ;Branch if yes ADD CHRWID,VD$X(R5) ;Space over for next character INC CURCOL ;Bump the current column number by one RETURN ;+ ;If a character has been displayed in the last column set the End of line ;flag. ;- 45$: MOV SP,(PC)+ ;Set end of line flag EOLFLG:: .WORD 0 ;EOL flag (<> entered char. in last column) TST LINREN ;Double wide line BEQ 50$ ;No single SUB CHRWID,VD$X(R5) ;Adjust x coordinate DEC CURCOL ;Adjust current column number 50$: RETURN .DSABL LSB .SBTTL SETATT - Set attribute flag words ;+ ;SETATT ;Set up character attribute flag words to correspond to bits set in the ;low four bits in D$ATT byte. At this time it has been determined that the ;the character in the low byte of R0 is a printable character. ; ;Entry: R1 -> Current character cell entry ; R5 = controller register for video slot ; ;Call: CALL SETATT ;Set attribute flag words for further process ; ;Exit: R1 -> Current character cell entry ; R5 = controller register for video slot ; R2, R3 and R4 changed ; Word flags D$BOLD, D$UNDR, D$BLNK, and D$REVR have been cleared or ; set to 1 depending on the bit setting. ;- .ENABL LSB SETATT::MOV #D$BLNK,R2 ; -> to start of 4 byte char. attribute bytes $REL .-2,D$BLNK,PI MOV @R1,R4 ;Get current character cell MOV #4,R3 ;Set up count for loop 10$: CLR @R2 ;Initialize flag words ASL R4 ;Shift bit to test attribute presence ROL (R2)+ ;Set byte flag if attribute requested SOB R3,10$ ;Loop until done .IF NE MMG$T ;If not XM TSTB D$COLM ;132 column mode? BEQ 15$ ;Branch if 80 column CLR D$BOLD ;No bold in 132 mode .ENDC ;NE MMG$T 15$: RETURN .DSABL LSB .SBTTL GETSCL - Get fonts for character and store ;+ ;GETSCL ;Point to the proper scan line table representing the current character and ;character set. Use the table to get the scan lines and store the lines in ;the temporary buffer. ; ;Enter: R1 -> Current character cell entry ; R5 = controller register for video slot ; ;Call: CALL GETSCL ;Get and store scan lines ; ;Exit: All registers have been modified ; CURCHR - Updated with pixel lines for display ;- .ENABL LSB GETSCL::MOV @R1,R4 ;Get character cell entry MOV R4,-(SP) ;Save it BIC #^C<7000>,R4 ;Isolate the font SWAB R4 ;Put it into low byte (already an offset) MOV C$SET(R4),R0 ;Get the address for the correct character $REL .-2,C$SET,PIV BIC #^C<177>,@SP ;Isolate the ASCII code for the character CMP R4,# ;Possible line drawing set character? BNE 5$ ;Branch if no CMPB @SP,# ;Line drawing set character? BHIS 5$ ;Branch if no SUB #<40>,@SP ;Else add in offset to line drawing character 5$: ASL @SP ;Make it an offset ADD (SP)+,R0 ;Make a word index MOV @R0,R0 ;Get offset into PIXORG ADD #PIXORG,R0 ;Get the address of a pixel vector $REL .-2,PIXORG,PI MOV #,R5 ;Pixel words per character (loop count) MOV #CURCHR,R1 ;R1 -> temporary character buffer $REL .-2,CURCHR,PIV TST LINREN ;Building the bottom half of character? BEQ 10$ ;Branch if no MOV #DBLCHR,R1 ;Point to double character temporary buffer $REL .-2,DBLCHR,PIV 10$: MOVB (R0)+,R4 ;Get value from pixel vector BIC #^C<377>,R4 ;May not be needed (check maximum value) CMPB #12.,R4 ;Is it an offset or blank count? BLOS 20$ ;Offset ADD R4,R1 ;Adjust temporary buffer pointer past blanks ADD R4,R1 ; Twice for word adjustment 15$: SUB R4,R5 ;Subtract number of blanks from loop count BGT 10$ ;Not done yet, get next scan line RETURN 20$: ASL R4 ;Make into word index .IF NE MMG$T ;If XM TSTB D$COLM ;132 column mode? BEQ 25$ ;Branch if in 80 column mode MOV VD$132-24.(R4),(R1)+ ;Get the pattern into temp $REL .-2,VD$132-24.,PIV BR 30$ ;A pixel done .ENDC ;NE MMG$T 25$: MOV VD$80-24.(R4),(R1)+ ;Get the pattern into temp $REL .-2,VD$80-24.,PIV 30$: SOB R5,10$ ;A pixel done RETURN .DSABL LSB .SBTTL DOUBLE - Stretch and store pixel lines for character ;+ ;DOUBLE ;Equivalant in operation to GETSCL except that the pixel line is stretched ;to a two word representation in the temporary character buffer for display. ;If displaying the bottom half the vector pointer must be adjusted to point ;to the second half of the character. ; ;Enter: R0 -> start of vectors for current character ; R1 -> start of current character buffer to store lines ; R5 = Loop count (number of lines to store) == CBUFSZ ; ; ;CALL: CALL DOUBLE ;Go do doubling ; ;Exit: All registers have bee modified ; CURCHR - Updated with pixel lines for display ;- .ENABL LSB DOUBLE::MOV #,R0 ;R0 -> single rep. of character to double $REL .-2,DBLCHR,PIV MOV #,R1 ;R1 ->character buffer to store stretched line $REL .-2,CURCHR,PIV MOV #,R5 ;Set up loop count BIT #,LINREN ;Double high rendition? BEQ 5$ ;Branch if double wide - single high ASR R5 ;Reduce count by half BIT #,LINREN ;Double high bottom? BEQ 5$ ;Branch if no ADD #,R0 ;Point to bottom half 5$: CLR R2 ;Initialize words for stretched bits CLR R3 ; 10$: MOV (R0)+,R4 ;Get next pixel line BEQ 30$ ;Branch if blank scan line TST D$BOLD ;Is bold rendition set? BEQ 15$ ;Branch if yes MOV #<240>,-(SP) ;Get bit pattern that causes space BIC R4,(SP)+ ;Clear character bits BNE 15$ ;Branch if bit combination not there BIS #<100>,R4 ;If both bits set put in filler 15$: MOV R1,-(SP) ;Save buffer pointer MOV CHRWID,R1 ;Get character width NEG R1 ;Calculate number of ADD #16.,R1 ; remaining bits in the data word ASH R1,R4 ;Shift the unused bits out MOV CHRWID,R1 ;Reset the bit count 20$: ASHC #2,R2 ;Shift previous bits ROL R4 ;Shift next bit to determine on or off BCC 25$ ;Branch if bit is 0 BIS #3,R3 ;Else double the bit 25$: SOB R1,20$ ;Branch until done stretching the word MOV (SP)+,R1 ;Restore buffer pointer 30$: MOV R3,(R1)+ ;Store left side of character .IF NE MMG$T ;If XM TSTB D$COLM ;132 mode? BEQ 35$ ;Branch if in 80 column mode ASHC #5,R2 ;Shift side of char & fall through for more ; for a total of a shift of 9 .BR 35$ ;Make sure second ASHC immediately follows .ENDC ;NE MMG$T 35$: ASHC #4,R2 MOV R2,CBUFSZ*2-2(R1) ;Store right side of character BIT #,LINREN ;Half high processing? BEQ 40$ ;Branch if no MOV R2,CBUFSZ*2(R1) ;For double - store stretched lines MOV -2(R1),(R1)+ ; a second time 40$: SOB R5,5$ ;Loop until full character has been stretched 45$: RETURN .DSABL LSB .SBTTL SETREN - Set appropriate character renditions ;+ ;SETREN ;Modify the pixel lines stored in the temporary character buffer depending ;on character renditions specified. ; ;Enter: R0 -> start of temporary character buffer ; ;Call: CALL SETREN ;Set the rendition ; ;Exit: ;- .ENABL LSB SETREN::TST LINREN ;Are we doubling the character BEQ 5$ ;Branch if single width CALL 5$ ;If yes display twice as much 5$: MOVB D$SCNM,R2 ;Sign extend of R2=0 since D$SCNM=0 or 1 MOV D$REVR,-(SP) ;Save reverse character attribute setting MOV #<51001>,CLRSET ;BIS @R0,R1 CLR R3 ;Assume dark background XOR R2,@SP ;Compute D$SCNM .XOR. D$REVR BEQ 10$ MOV #<41001>,CLRSET ;BIC @R0,R1 COM R3 ;Assume white background 10$: BIS D$BOLD,@SP ;Compute (D$SCNM .XOR. D$REVR) .OR. D$BOLD TST D$UNDR ;Requesting underscore character attribute? BEQ 15$ ;Branch if no BIT #,LINREN ;Displaying top half of double wide/high? BNE 15$ ;Branch if yes, skip underscore MOV #LIGHT,*2(R0) ;Assume bold underscore TST D$BOLD ;Was assumption correct BNE 15$ ;Branch if yes, bold underscore stored MOV #GREY,*2(R0) ;Set underscore to grey 15$: MOV #,R2 ;Get scan line count 20$: TST @SP ;Test (D$SCNM .XOR. D$REVR) .OR. D$BOLD BEQ 30$ ; MOV #1,R4 ;Set initial loop count for stretching BITB @SP,D$BOLD ;Bolding? BEQ 25$ ;Branch if no. Stretch once INC R4 ;Stretch twice 25$: MOV @R0,-(SP) ;Stretch ASL @SP ; the BIS (SP)+,@R0 ; character SOB R4,25$ ;Branch if done 30$: MOV R3,R1 ;Get the background CLRSET: .WORD 0 ; and BIS or BIC the character into it MOV R1,(R0)+ ;Move newly formed pattern back into buffer SOB R2,20$ ;Loop through all of character's scan lines TST (SP)+ ;Pop (D$SCNM .XOR. D$REVR) .OR. D$BOLD RETURN .DSABL LSB .SBTTL CHKCHR - Character parser ;+ ;CHKCHR ;Parsing routine. Compares a character in R0 with a character in a table ;passed in R4. If the character is found in the table the following byte ;is used as a offest into the routine to be executed. This routine then ;finds the routine using the second byte and dispatches to it. If the ;character is not found in the table the C-bit is set on return. ; ;Input: R0 = ASCII character to compare against table ; ;Call: JSR R4,CHKCHR ;Check for character match ; ;C-bit set if no match. ;- .ENABL LSB CHKCHR::TSTB @R4 ;End of table? BNE 5$ ;Branch if not TST (R4)+ ;-> instruction following the end of table BR 15$ ;Set c-bit on exit 5$: CMPB R0,(R4)+ ;Is there a character match? BEQ 10$ ;Branch if yes TSTB (R4)+ ;Point to next entry BR CHKCHR ;No, check next entry in table ;+ ;A character match has been made. Turn offset into actual address ;of routine to handle the character. Then dispatch to it. ;- 10$: CLR R0 ;Upper byte is cleared BISB (R4)+,R0 ;Lower byte is word displacement ASL R0 ;Byte displacement to appro. routine ADD R0,R4 ;Point to character routine TST (PC)+ ;Make sure C-bit cleared for no error 15$: SEC ;Set C-bit for error RTS R4 ;Return to caller .DSABL LSB .SBTTL CTRL - Process control characters ;+ ;CTRL ;The following routine is entered if the offset produced in PUTCHR ;is less than 0. In the case the character being processed is in ;the ASCII code range of 0 to 37. This routine checks for special ;characters (in the table below) and dispatches to the appropriate ;routine to take the correct action for the character. Control ;then returns to the main routine from which it was called. ;- .ENABL LSB CTRL:: MOV #,R3 ;Set flag in R3 CMPB #,ESCTYP ;Processing a control string sequence? BNE 5$ ;Branch if no CMPB R0,# ;Is character part of valid control set? BLO 5$ ;No CMPB R0,# ;Within special set? BLOS 10$ ;Yes, ignore character 5$: JSR R4,CHKCHR ;Check for character match .CHRDIS ENQ,SPCENQ,VALUE ;Enquire character .CHRDIS BELL,SPCBEL,VALUE ;Bell character .CHRDIS BS,SPCBS,VALUE ;Backspace character .CHRDIS HT,SPCHT,VALUE ;Horizontal tab character .CHRDIS LF,SPCLF,VALUE ;Linefeed character .CHRDIS VT,SPCVT,VALUE ;Vertical tab character .CHRDIS FF,SPCFF,VALUE ;Formfeed character .CHRDIS CR,SPCCR,VALUE ;Carriage return character .CHRDIS SO,SPCSO,VALUE ;G1 character set .CHRDIS SI,SPCSI,VALUE ;G0 character set .CHRDIS XON,SPCXON,VALUE ;Continue transmission .CHRDIS XOFF,SPCXOF,VALUE ;Cease transmission .CHRDIS CAN,SPCCAN,VALUE ;Cancel any current sequence .CHRDIS SUB,SPCSUB,VALUE ;Cancel any current sequence .CHRDIS ESC,SPCESC,VALUE ;Escape character .WORD 0 ;End of table 10$: RETURN .DSABL LSB .SBTTL Individual control routines .ENABL LSB ;+ ;Link for escape character. ;- SPCESC: CALLR ESCAPE ;Go to escape routine ;+ ;ENQUIRE CHARACTER. Transmits answerback message. ;- SPCENQ: MOV #C.ANSR,R3 ;Point to answerback message buffer $REL .-2,C.ANSR,PIK CALLR SNDREP ;Send it message ;+ ;BELL CHARACTER ;Registers R1 and R5 are saved by QKBOUT. ;- SPCBEL: MOV #KBELL,R0 ;Put bell character in R0 CALLR QKBOUT ;Queue the code in R0 to KB transmitter ;+ ;BACKSPACE CHARACTER ;- SPCBS: CALL STPCUR ;Stop cursor blink MOV CURROW,R0 ;Get current row number ASL R0 ;Double it to make it and offset BIT #,LINCEL(R0) ;Is this line doubled? $REL .-2,LINCEL,PIV BEQ 5$ ;Branch if no INC R3 ;If yes, backspace two columns (R3 = SET) 5$: MOV CURCOL,R1 ;Get current column number CMP R1,MAXCOL ;Beyond maximum column number? BLE 10$ ;Branch if not MOV MAXCOL,R1 ;Update current column number for last column 10$: SUB R3,R1 ;Calculate new column number BCC 40$ ;Past left margin? CLR R1 ;Clear current column number BR 40$ ;Branch to common calculation and exit code ;+ ;HORIZONTAL TAB CHARACTER ;- SPCHT: CALL STPCUR ;Stop cursor blink MOV #TABSTP,R2 ;R2 -> start of tab stop table $REL .-2,TABSTP,PIV MOV R2,-(SP) ;Save start for later MOV CURCOL,R1 ;Get current column MOV CURROW,R0 ;Get current row number ASL R0 ;Make it an offset MOV LINCEL(R0),R0 ;Get line attribute $REL .-2,LINCEL,PIV BIC #^C,R0 ;Isolate line attribute bits BEQ 15$ ;Branch if single wide ASR R1 ;Adjust doubled column to single 15$: ADD R2,R1 ;Point to current position in table MOV MAXCOL,R3 ;Get maximum column count ADD R3,R2 ;R2 = Furtherest column on screen INC R1 ;Bump pointer past original position 20$: CMP R1,R2 ;Reached end of screen? BLT 25$ ;Branch if no MOV R2,R1 ;Get ending address BR 30$ ;Go convert to x coordinate and update reg. 25$: TSTB (R1)+ ;<> is tab stop BEQ 20$ ;Loop till stop found or end of line DEC R1 ;Reset pointer to tab stop 30$: SUB (SP)+,R1 ;Get displacement TST R0 ;Double wide line? BEQ 35$ ;Branch if single ASL R1 ;Yes, double the column count TSTB -(R3) ;Point to start of last character 35$: CMP R1,R3 ;Pointing beyond table? BLOS 40$ ;Branch if no MOV R3,R1 ;Set to end of table 40$: CLR R0 ;Clear for MUL MOV R1,CURCOL ;Update current column number MUL CHRWID,R1 ;Convert to pixels for x coordinate MOV R1,VD$X(R5) ;Update x coordinate register CLR EOLFLG ;Reset end of line flag RETURN ;+ ;LINEFEED, VERTICAL TAB, and FORMFEED CHARACTERS ;- SPCLF: ;Linefeed SPCVT: ;VT100, interpreted as LF SPCFF: ;VT100, interpreted as LF CALL STPCUR ;Stop cursor blink CALL SCROLL ;Adjust Y coordinate and set up for scroll TSTB A$LNM ;New line mode? BNE 45$ ;Branch if yes, must start on new line RETURN ;+ ;CARRIAGE RETURN CHARACTER ;- SPCCR: CALL STPCUR ;Stop cursor blink 45$: CLR VD$X(R5) ;Back to left margin CLR CURCOL ;Clear current column number CLR EOLFLG ;Reset end of line flag RETURN ;+ ;SHIFT IN/SHIFT OUT character set. ;- SPCSI: CLR R3 ;Set flag byte to shift in state (assume) SPCSO: MOVB A$G0,CHRSET ;G0 as current character set (assume SHIFT IN) MOVB R3,D$SISO ;Set shift in/out flag byte BEQ 50$ ;Branch out if shift in assumption was correct MOVB A$G1,CHRSET ;Set current character set to G1 50$: RETURN ;+ ;XON/XOFF CHARACTERS ;Notify keyboard of transmit state. ;+ SPCXON: CLRB R3 ;Set flag 0 to resume transmission SPCXOF: MOVB R3,KB$OFF ;0=resume; 1 = stop transmission RETURN ;+ ;CAN and SUB characters. Abort any escape sequence processing and display ;checkerboard character. ;- SPCCAN: SPCSUB: CALL SCWAIT ;Wait until scrolling is done MOV #<*400+'a>,R4 ;R4 = line set checkerboard character CLR @SP ;Initialize stack - return destroyed BISB D$ATT,@SP ;Get current character rendition ASL @SP ;Set in high byte to store in cell SWAB @SP ;Put in high byte BIS (SP)+,R4 ;Store attributes into current cell CALL CLRFL ;Reset escape flags CALLR STRCEL ;Go store in cell and display ;+ ;ESCAPE CHARACTER ;Set escape sequence processing flag (ESCPRO). ;- ESCAPE: TSTB ESCPRO ;Escape already in progress? BEQ 55$ ;Branch if no - init flags and set PRO flag CMPB #,ESCTYP ;Yes, processing a control string sequence? BNE 55$ ;No, restart escape processing MOVB #,ESCEND ;Yes, set flag for possible end of sequence BR 60$ ; and return 55$: CALL CLRFLG ;Initialize all escape flags and buffers MOVB #,ESCPRO ;Set escape processing flag 60$: RETURN .DSABL LSB .SBTTL SEQTYP - Escape sequence type determination ;+ ;SEQTYP ;This routine is entered on the first character that follows the ESCAPE ;character. This character is used to determine the escape sequence type ;(either DCS, CSI, or sequence) and dispatches to the appropriate routine if ;found. ;- .ENABL LSB SEQTYP::JSR R4,CHKCHR ;Check for character match .CHRDIS [,ESCCSI ;Control sequence .CHRDIS P,ESCDCS ;Control string sequence .CHRDIS ],ESCDCS ;Control string sequence .CHRDIS UPA,ESCDCS,VALUE ;Control string sequence .CHRDIS UNS,ESCDCS,VALUE ;Control string sequence .WORD 0 ;End of list BCC 10$ ;Branch around if CSI or DCS sequence MOVB #,ESCTYP ;Assume escape sequence BR SEQDIS ;Goto dispatcher to find more about character ESCCSI: MOVB #,ESCTYP ;Set type to control sequence CLRB QFLAG ;Initialize question mark flag MOV #ESCDEF,R1 ;Point to start of default buffer $REL .-2,ESCDEF,PI MOV #MAXPAR,R2 ;Get number of locations to set 5$: MOVB #1,(R1)+ ;Set default flag <> for initialization SOB R2,5$ ;Loop until all have been initialized 10$: RETURN ESCDCS: MOVB #,ESCTYP ;Set type to control string sequence RETURN .DSABL LSB .SBTTL SEQDIS - Sequence dispatcher ;+ ;SEQDIS ;Routine to determine the type of sequence processing in progress and ;dispatch to the appropriate routine to continue processing. Before ;dispatching the value in R0 is (character-40). This value is re-instated ;as an ASCII code value. ;- .ENABL LSB SEQDIS::MOV #,R3 ;Assume we'll be setting modes CMPB #,ESCTYP ;Control string sequence? BNE 5$ ;Branch if no .BR CTRLST ;+ ;CONTROL STRING SEQUENCE escape processing. Since control string sequences ;are not a function of VT100's this routine recognizes the sequences, parses ;it but ignores it. No action. The end of a control string sequence is ;always determined by a '\' combination. Therefore, if escape is found ;the ESCEND flag is set. If the next character is a backslash then the ;sequence is complete and cleanup is done. If not a new sequence is started ;and cleanup should be done. Then use the character in R0 to determine the ;new sequence type. ;- CTRLST: TSTB ESCEND ;Processing possible end of sequence? BEQ 20$ ;Branch if not. Just ignore character CLR ESCERR ;Clear error flag CLRB ESCTYP ;Clear type flag byte CLRB ESCEND ;Clear string end flag byte CMPB #'\,R0 ;Backslash character? BEQ 20$ ;Yes, end of sequence CALLR SEQTYP ;No, process new escape sequence 5$: CMPB #,ESCTYP ;Control sequence? BEQ CTRLSQ ;Branch if yes .ASSUME E$SEQ EQ 1 ;+ ;ESCAPE SEQUENCE. Check if within the intermediate range (40-57). To ;get this far (SEQDIS) the low range has been determined greater that 37. ;- CMPB R0,#<'/> ;Low range already checked. Is the character ; an intermediate? BHI 15$ ;Branch if not (final character) TST (PC)+ ;Was intermediate already processed? SEQINT: .WORD 0 ;Intermediate character BNE 10$ ;Yes, set error flag to ignore rest MOV R0,SEQINT ;Save intermediate character RETURN ;Get next character 10$: MOV SP,ESCERR ;Set error flag <> to denote ingore rest RETURN ;+ ;Character in range of final character (60-176) for escape sequence ;- 15$: TST ESCERR ;Was error determined on sequence? BNE 20$ ;Branch if yes. Ignore sequence. JSR R4,CHKCHR ;Check for character match .CHRDIS H,ESCHTS ;Set tab stops .CHRDIS EQ,ESCSKM,VALUE ;Keypad application mode .CHRDIS >,ESCRKM ;Keypad numeric mode .CHRDIS N,SS2 ;Single shift in 2 .CHRDIS O,SS3 ;Single shift in 3 .WORD 0 ;Table end BCC 20$ ;Branch if found and processed CALL CURMOV ;See if cursor move sequence (or line size) 20$: CALLR CLRFLG ;Init escape flags and reset pointers CTRLSQ: CALLR ESCLBR ;Process as control string .DSABL LSB .SBTTL Individual escape sequence routines .ENABL LSB ;+ ;Set tab stops. ;- ESCHTS: MOV #TABSTP,R1 ;R1 -> start of byte flag tab stop table $REL .-2,TABSTP,PIV ADD CURCOL,R1 ;Point to current position in byte table MOVB R3,@R1 ;Set byte flag on (R3=1) CALLR CLRFLG ;Init escape flags and reset pointers ;+ ;Application/numeric keypad mode. ESCSKM entry point is set APPLICATION mode. ;ESCRKM entry point is NUMERIC keypad mode. R3 = 1 (SET) from SEQDIS. ;- ESCRKM: CLR R3 ;Set keypad mode to numeric ESCSKM: MOVB R3,D$KPD ;Set mode. CALLR CLRFLG ;Init escape flags and reset pointers ;+ ;SS2 - Single shift in 2 ;Selects G2 character set for one (next) printable character. ;See D$SSI byte location for values used for single shift in. ; ;SS3 - Single shift in 3 ;Selects G3 character set for one (next) printable character. ;See D$SSI byte location for values used for single shift in. ; ;Entry: R3 = 1 ;- SS3: INC R3 ;Make value 2 SS2: MOVB R3,D$SSI ;1 = single shift in 2; 2 = single shift in 3 CALLR CLRFLG ;Init escape flags and reset pointers .DSABL LSB .ENABL LSB CURMOV: CALL STPCUR ;Stop cursor blink TST SEQINT ;Processing seq. with an intermediate char? BNE INTERM ;Branch if yes JSR R4,CHKCHR ;Check for character match .CHRDIS c,RIS ;Reset to initial state .CHRDIS D,IND ;Index .CHRDIS E,NEL ;Next line .CHRDIS M,RI ;Reverse index .CHRDIS 7,DECSC ;Save cursor .CHRDIS 8,DECRC ;Restore cursor .CHRDIS Z,DECID ;Identify terminal .WORD 0 ;Table end RETURN ;+ ;RIS ;- RIS: CALLR RISTAT ;Go reset the world my son ;+ ;DECID ;Identify terminal ;Reply with the terminal ID. Same as primary DA. ;Format: ; Z ;+ DECID: CALL CLRFLG ;Init escape flags and reset pointers MOV #C.REPL,R3 ;Point to reply string $REL .-2,C.REPL,PIK CALLR SNDREP ;Go send the reply ;+ ;INDEX ;Move active position downward on line, scrolling if necessary. Format of ;escape sequence is: ; ; D ; ;If the active position is above the bottom margin, it will not move beyond ;the margin. If the active position is below the margin, it will not move ;beyond the bottom of the display. Scrolling will not occur. This control ;is identical to the line feed control, except it is not affected by new line ;mode. ;- IND: CALLR SCROLL ;Adjust y coordinate and scroll ;+ ;REVERSE INDEX ;Move active position upward on line, scrolling if necessary. The format of ;the sequence is: ; ; M ;If active position is below top margin, it will not move beyond the top ;margin. If the active position is above the top margin (as a result of ;active cursor positioning) it will still move upward by one line and no ;scrolling will occur. In this case, the active position will not move ;beyond the first line of the display. ;- RI: CALLR BACSCL ;Check if scroll necessary and if so do it ;+ ;NEXT LINE ;Move active position to the first column of the next line, scrolling if ;necessary. The format of the sequence is: ; ; E ; ;This control is identical to sending a line feed with line feed new line ;mode set. ;- NEL: CALL SCROLL ;Adjust y coordinate and scroll CLR VD$X(R5) ;Start in first position CLR CURCOL ;Clear current column number RETURN ;+ ;DECSC ;Save cursor - saves current cursor position, character attributes (graphic ;rendition), character set (G0, G1, and current character set), origin mode ;and end of line flag. G2 and G3 are not part of the VT100 support at this ;time. ; ;Format: ; ; 7 ; ;Only one level of storage is provided. Each execution causes previously ;stored values to be lost. ;- DECSC: MOV #CURSAV,R0 ;Get pointer to cursor save buffer $REL .-2,CURSAV,PIV MOVB A$G0,(R0)+ ;Save G0 character set MOVB A$G1,(R0)+ ;Save G1 character set MOV CHRSET,(R0)+ ;Save SHIFT IN character set MOV EOLFLG,(R0)+ ;Save end of line flag MOV CURCOL,(R0)+ ;Save current column number MOV CURROW,(R0)+ ;Save current row number MOVB D$ATT,(R0)+ ;Save character attribute MOVB D$OM,(R0)+ ;Save current origin mode RETURN ;+ ;DECRC ;Restore cursor - Restores character attributes (graphic rendition), ;character set (G0, G1, and current character set), origin mode and end ;of line flag. G2 and G3 are not part of the VT100 support at this time. ;It restores the saved cursor position. If the cursor position lies ;outside the scrolling region, and the restored origin mode is set, the ;active position will be moved to the closest position within the scrolling ;region. ; ;Format: ; ; 8 ;- DECRC: MOV #CURSAV,R0 ;Get pointer to cursor save buffer $REL .-2,CURSAV,PIV MOVB (R0)+,A$G0 ;Restore G0 character set MOVB (R0)+,A$G1 ;Restore G1 character set MOV (R0)+,CHRSET ;Restore SHIFT IN character set MOV (R0)+,EOLFLG ;Restore end of line flag MOV (R0)+,R3 ;Restore current column number MOV (R0)+,R1 ;Restore current row number MOVB (R0)+,D$ATT ;Restore old attributes TSTB D$OM ;Is origin mode set? BEQ 10$ ;Branch if no CMP R1,TOPROW ;Is restored y above top margin? BLE 5$ ;Branch if no MOV TOPROW,R1 ;Set Y coordinate to top margin 5$: CMP R1,BOTROW ;Is restored Y below bottom margin? BHIS 10$ ;Branch if no MOV BOTROW,R1 ;Set y coordinate to bottom margin 10$: MOV R1,CURROW ;Reset current row MUL CHRHIG,R1 ;Convert to x coordinate ;+ CALL SCWAIT ;Wait for scrolling to finish ;- MOV R1,VD$Y(R5) ;Update y register with current y coordiante MOV R1,ROWYCO ;Update y coordinate current value CLR PRVCHR ;Initialize previous character word MOVB @R0,D$OM ;Restore current origin mode MOV R3,CURCOL ;Store new current column MUL CHRWID,R3 ;Convert to x coordinate MOV R3,VD$X(R5) ;Store in x register RETURN .DSABL LSB .SBTTL INTERM - Intermidiate character processing ;+ ;INTERM ;Check for valid intermediates. Valid characters are #, (, and ). ;- .ENABL LSB INTERM: CMPB #<'#>,SEQINT ;Line size command? BEQ LINATT ;Branch if yes MOV #CHRSET,R2 ;Assume select character set sequence by $REL .-2,CHRSET,PI CMPB #<')>,SEQINT ;G1 desigator? BEQ ESCG1D ;Branch if yes, else ignore CMPB #<'(>,SEQINT ;G0 designator? BNE 25$ ;Branch if no to ignore error .BR ESCG0D ;+ ;Select character set sequence ;ESCG0D entry point for select G0 designator. If Shift in/Shift out state is ; set modify the current character set word (CHRSET). ; ;ESCG1D entry point for select G1 designator. If Shift in/Shift out state is ; set modify the current character set word (CHRSET). ; ;On entry: ; R0 = final character ; R2 = pointer to current character set word ; R3 = 1 ; ; If the current character set is not to be updated then R2 becomes the same ; as R1. Therefore the designator byte is updated twice (common routine can ; be used without multiple checks). ;- ESCG0D: MOV #A$G0,R1 ;Store G0 address for designator $REL .-2,A$G0,PI TSTB D$SISO ;Shift in state in effect? BEQ 10$ ;Branch if yes. R2 -> CHRSET to modify BR 5$ ;Make R2 and R1 point to G0 byte designator ESCG1D: MOV #A$G1,R1 ;Store G1 address for designator $REL .-2,A$G1,PI TSTB D$SISO ;Shift out state in effect? BNE 10$ ;Branch if yes. R2 -> CHRSET to modify 5$: MOV R1,R2 ;R2 and R1 point to byte designator to set .BR 10$ ;Return at common exit ;+ ;Change character sets routine in G0 and G1. G2 and G3 are not supported ;in this release as are the other special character sets. If the request ;is for something other than the US set further parsing is done. The only ;other valid values returned from PUTCHR at this time is "0 or A". ;1 and 2 characters are ignored. ;- 10$: CMPB #<'B>,R0 ;US character set? BEQ 15$ ;Branch if yes CMPB #<'0>,R0 ;Is it the special graphics and line drawing? BEQ 20$ ;Branch if yes INC R3 ;Assume the line and special graphics set CMPB @#S$VDF,R0 ;Correct national character set? $REL .-2,S$VDF,PI BEQ 20$ ;Branch if yes RETURN ;No, just ignore 15$: DEC R3 ;Set set code to NCR set (R3=0) 20$: MOVB R3,@R1 ;Store value in appropriate flagbyte MOVB R3,@R2 ;Val. in CHRSET of flagbyte depending on state 25$: RETURN .DSABL LSB .SBTTL LINATT - Line attribute determination ;+ ;LINATT ;Set line attributes. Only one rendition may be set per line (they are ;mutually exclusive).Setting double-wide or double height renditions ;doubles the character cell width within the line, but does not affect ;the addressing of characters in the line. ;Format: ; ; # n ; ;The valid parameters for 'n' are: ; ; Parameters Rendition ; ---------- --------- ; 3 Double high/double wide top ; 4 Double high/double wide bottom ; 5 Single high/single wide ; 6 Single high/double wide ; ;Enters: R3 = 1 (SET) ;- .ASSUME D$DSWL EQ 0 ;Single width line (#5) .ASSUME D$DHLT EQ 1 ;Double high line - top half (#3) .ASSUME D$DHLB EQ 2 ;Double high line - bottom half (#4) .ASSUME D$DWL EQ 4 ;Double width line (#6) .ENABL LSB LINATT: JSR R4,CHKCHR ;Check for character match .CHRDIS 3,DHLT ;Double high line top half .CHRDIS 4,DHLB ;Double high line bottom half .CHRDIS 5,DSWL ;Single width line .CHRDIS 6,DWL ;Double width line .CHRDIS 8,DECALN ;Display alignment pattern .WORD 0 ;Table end RETURN DSWL: CLR R3 ;Set up bit definition (0 = SW/SH)- default DWL: ASL R3 ;Shift attribute bit definition (D$DWL) DHLB: ASL R3 ;Shift attribute bit definition (D$DHLB) DHLT: ;Double high line top MOV CURROW,R0 ;Get current row number ASL R0 ;Make it an offset MOV LINCEL(R0),R1 ;Get line cell entry for current line $REL .-2,LINCEL,PIV BIC #^C,R1 ;Isolate rendition bits CMP R1,R3 ;Are we trying to set the same rendition? BEQ 25$ ;Branch out if yes BIC #,LINCEL(R0) ;Clear line rendition bits $REL .-2,LINCEL,PIV BIS R3,LINCEL(R0) ;Set new line rendition bit $REL .-2,LINCEL,PIV CMP R1,R3 ;Changing from double to single or visa/versa? BLO 5$ ;Branch if going from single to double TST R3 ;Double to single? BNE 20$ ;Branch if double to double ASR CURCOL ;Half the cursor pointer BR 20$ ;Now get back into place 5$: TST R1 ;Single to double? BNE 20$ ;Branch if double to double ASL CURCOL ;Double the cursor pointer MOV MAXCOL,R3 ;Get maximum number of columns (bytes) DEC R3 ;Round down CMP CURCOL,R3 ;New cursor beyond last character? BLE 10$ ;Branch if no MOV R3,CURCOL ;Else make the cusor the end 10$: TST (R3)+ ;Restore max col and round up for count MOV CELSTR(R0),R1 ;R1 -> Start of character cell for current row $REL .-2,CELSTR,PIV ADD R3,R1 ;Point to second half of line MOV #BLANK,R2 ;Get character cell entry to store 15$: MOV R2,(R1)+ ;Initialize character cell entry SOB R3,15$ ;Loop until done 20$: MOV CURCOL,-(SP) ;Save current column number MOV CURROW,R3 ;Set up for refresh routine display 1 row CALL REFRSH ;Re display row MOV (SP)+,R1 ;Restore current column number MOV R1,CURCOL ;Store column new number MUL CHRWID,R1 ;Convert to x coordinate MOV R1,VD$X(R5) ;Store it in x register 25$: RETURN ;+ ;DECALN ;Fills screen with uppercase E's for scree focus and alignment. ;Format: ; ; # 8 ; ;The E's should be stored in character cell. Both current line and ;character renditions are reset to normal. ;- DECALN: MOV #CHRCEL,R1 ;Point to start of character cell table $REL .-2,CHRCEL,PIV MOV #CELWRD,R3 ;Get number of words in the character cell MOV #+<'E>,R0 ;Get ASCII character 30$: MOV R0,(R1)+ ;Move character into cell SOB R3,30$ ;Loop until buffer filled CALL CLRSCR ;Clear the screen MOV #CHRLIN-1,R3 ;Displaying full screen CALL REFRSH ;Refresh the screen CLR CURCOL ;Clear current column number CLR CURROW ;Clear current row number CLR VD$X(R5) ;Clear x register CLR VD$Y(R5) ;Clear y register CLR PRVCHR ;Initialize previous character word CLR EOLFLG ;Reset end of line flag RETURN .DSABL LSB .SBTTL ESCLBR - Escape left bracket routine ;+ ;ESCLBR ;Control sequences are of the form: ; ; CSI (233) P...P (060--077) I...I (040--057) F (060--176) ; or ESC[ P...P (060--077) I...I (040--057) F (060--176) ; where P is parameter, I is intermediate, and F is final ; ;This routine is entered when the ESCAPE [ is encountered. If the character, ;on entry, is a final character, any accumulated values (parameter value) is ;stored in the escape buffer. ; ;If an intermediate character is in R0 on entry, an occurance of a previous ;intermediate character is checked (SEQINT is <>). If so, ignore the ;character and return from this routine to get the next character. If the ;it is the first occurance, set the flag word (SEQINT) and return to caller. ; ;If the character is a parameter, check if a intermediate character has been ;processed. If so, set the error flag and exit the routine. Else, determine ;if the character is a accepted parameter character. If it is not, exit the ;routine to ignore the character. If the character is a semi-colon or ;question mark branch to the appropriate routine. If it is a numeric value ;convert it to a value and return to the caller. ; ;If the first character is question mark, then the DECMOD flag is set to ;denote a private sequence is expected. If the question mark is anywhere else ;in the sequence it is treated as a unrecognized parameter character and is ;ignored. ; ;If a ; (parameter seperater) is encountered, the contents of the accumulator ;is stored in the escape parameter buffer. ;- .ENABL LSB ESCLBR: CMPB R0,#100 ;Final character? BHIS 45$ ;Branch if yes TST ESCERR ;Was an error occured during processing? BNE 10$ ;Yes, ignore the character CMPB R0,#60 ;Parameter character? BLO 40$ ;No, intermediate character TST SEQINT ;Intermediate character been processed already BNE 35$ ;Yes, set error flag and return CMPB R0,#<';> ;Parameter - seperator character? BEQ 15$ ;Branch if yes CMPB R0,#<'?> ;Parameter - private mode character? BEQ 25$ ;Branch if yes CMPB R0,#<'>> ;Greater than sign? BEQ 30$ ;Branch if yes - for processing CMPB R0,#<'9> ;Numeric? BHI 10$ ;No, ignore character TST OVRERR ;Has overflow error occured? BNE 10$ ;Branch out if yes SUB #<'0>,R0 ;De ascii-ize character MOV ACCUM,R1 ;R1 = accumulated value ASL R1 ;First digit * 2 ADD R1,R0 ;New digit + (first digit * 2) ASL R1 ;First digit * 4 ASL R1 ;First digit * 8 ADD R0,R1 ;Add in new digit BIT #174000,R1 ;Overflowed accumulator? BEQ 5$ ;Branch if no MOV SP,(PC)+ ;Else set flag to say so OVRERR: .WORD 0 ;<> overflow error occured MOV #-1,R1 ;On overflow use the highest parameter value 5$: MOV R1,ACCUM ;Store new value MOV SP,(PC)+ ;Set value specified flag to <> VALFLG: .WORD 0 ;<> denotes parameter value being processed 10$: MOVB #,QFLAG ;Set flag saying first character processed RETURN ;+ ;Parameter seperator. ;On entry, if overflow error has occured the value stored is the highest valid ;parameter value (377). It is ignored. If a value was not being processed, ;0 is entered in the buffer, an a -1 flag byte in a corresponding buffer is ;stored to denote that the value in that buffer position is a default. ; ;Otherwise, the value in ACCUM is stored in the escape parameter buffer. ; ;In either case, both the parameter and default buffer is incremented to the ;next position upon exit from this routine. ;- 15$: MOV EBPTR,R1 ;R1 -> current buffer pointer CMP R1,EBPTRE ;End of buffer? BGT 10$ ;Yes, ignore new value but retain buffer MOV DEFBUF,R2 ;R2 -> current default flag buffer entry CLRB @R2 ;Initially set to no default MOVB ACCUM,(R1)+ ;Point into buffer to store next parameter MOV R1,EBPTR ;Update current buffer pointer TST VALFLG ;Was value in progress? BNE 20$ ;Branch if yes COMB @R2 ;Set default flag for this position 20$: INC DEFBUF ;Update default flag buffer pointer CLR (PC)+ ;Initialize accumulator ACCUM: .WORD 0 ;Accumulated value for parameter CLR VALFLG ;Initialize value in progress flag CLR OVRERR ;Initialize overflow error flag BR 10$ ;Use common exit to return for next character ;+ ;Private mode character processing. ;- 25$: TSTB QFLAG ;Is this the first character in the sequence? BNE 35$ ;Branch if no. Set error condition MOVB #,DECMOD ;Set private mode flag BR 10$ ;Use common exit to return for next character 30$: TSTB QFLAG ;Is this the first character in the sequence? BNE 35$ ;Branch if no. Set error condition MOV R0,SEQINT ;Set intermediate character flag with char. BR 10$ ;Use common exit to return for next character ;+ ;Set error condition. ;- 35$: MOV SP,ESCERR ;Set error flag BR 10$ ;Use common exit to return for next character ;+ ;Intermediate character. ;- 40$: TST SEQINT ;Intermediate character already recieved? BNE 10$ ;No need to check for parameter in progress MOV R0,SEQINT ;Store the character as a flag CALL 15$ ;Store value if needed BR 10$ ;Exit routine for next character ;+ ;Final character processing. ;- 45$: TST VALFLG ;Parameter value being processed? BEQ 50$ ;Branch if no CALL 15$ ;Store value into escape parameter buffer 50$: TST ESCERR ;Did error occur during parsing? BNE 55$ ;Branch if yes, ignore sequence MOV #,R3 ;Make sure flag register set JSR R4,CHKCHR ;Check for character match .CHRDIS l,RM ;Reset mode .CHRDIS h,SM ;Set mode .CHRDIS m,SGR ;Character renditions .CHRDIS c,DA ;Device attributes .CHRDIS n,DSR ;Report .CHRDIS g,ESCTAB ;Clear tabs .WORD 0 BCC 55$ ;Final character found, and sequence processed CALL ESCECP ;If not found check for position or erase seq. 55$: CALLR CLRFLG ;Init escape flags and reset pointers RM: CLR R3 ;Reset mode - flag = 0 SM: CALLR SETRES ;Join common routine (in set mode R3 = 1) .DSABL LSB .ENABL LSB ;+ ;SGR ;Character renditions - Designate the graphic rendition to be applied to ;all subsequent characters enterd into the display. ;The format is: ; ; CSI (233) Ps ; ... ; Ps m ; or ESC[ Ps ; ... ; Ps m ; ;The default value is 0. ;The valid parameters are: ; ; Parameters Rendition ; ---------- --------- ; 0 All renditions off ; 1 Bold ; 4 Underscore ; 5 Blink ; 7 Negative (reverse) image ; ;Parameters are processed in the order that they appear in the string (same ;as what is stored in the escape parameter buffer. Unrecognized parameters ;are ignored. ; ;*** NOTE *** In this version, setting BLINK sets BOLD. This setting should ;be removed when BLINK support is included. ;- .ASSUME BLINK EQ 200 .ASSUME BOLD EQ 100 .ASSUME UNDER EQ 40 .ASSUME REVRSE EQ 20 SGR: CALL NOPARM ;Set the default parameter if not specified MOV #D$ATT,R0 ;R0 -> attribute flag byte $REL .-2,D$ATT,PI 5$: TSTB @R2 ;Clear attributes? BNE 10$ ;Branch if no BICB #,@R0 ;Yes, clear all character ;attributes BR 20$ ;Get next parameter 10$: MOV #,R3 ;Make sure flag word is set to reverse CMPB @R2,#7 ;Reverse? (7) BEQ 15$ ;Branch if yes ASL R3 ;No, set R3 to next bit definition CMPB @R2,#4 ;Underscore? (4) BEQ 15$ ;Branch if yes ASL R3 ;No, set R3 to next bit definition CMPB @R2,#1 ;Bold? (1) BEQ 15$ ;Branch if yes ASL R3 ;No, set R3 to next bit definition CMPB @R2,#5 ;Blink? (5) BNE 20$ ;Branch if not 15$: BISB R3,@R0 ;Set appropriate mask for selected attribute 20$: TSTB (R2)+ ;Get next parameter CMP R2,EBPTR ;End of parameters? BLT 5$ ;No, process next TSTB @R0 ;Is blink rendition set? BPL 25$ ;Branch if no BISB #,@R0 ;Yes, set BOLD rendition for blink for now 25$: CALLR CLRFLG ;Init escape flags and reset pointers ;+ ;DSR - Device status report ; ;Routine reports the general status of the terminal ;The format of the sequence request is: ;REPORT STATUS: ;Returns the current functional status. ; CSI 5n ; or [ 5n ;The response format is: ; [0n for terminal ready ; [3n for terminal malfunction ;***************************************************************************** ;REPORT ACTIVE POSITION: ;If the origin mode is not set, addressing is performed relative to the ;screen origin (upper left hand corner). If origin mode is set, addressing ;is performed relative to the origin (upper left hand corner) of the ;scrolling region (the first column in the Top Margin). ; ; CSI 6n ; or [ 6n ;The report format is: ; CSI Pl ; Pc R ; or [ Pl ; Pc R ; ;Unrecognized parameter values are ignored. ;- DSR: CALL NOPARM ;R2 -> parameter buffer 30$: CMPB #5,@R2 ;Report status DSR? BNE 35$ ;Branch if no MOV #TTOK,R3 ;Point to message string $REL .-2,TTOK,PI CALL SNDREP ;Go send the reply BR 45$ ;Check for more parameters 35$: CMPB #6,@R2 ;Report active position DSR? BNE 45$ ;Branch if no MOV #RPLYBF,R4 ;Point to reply buffer $REL .-2,RPLYBF,PI MOV R4,-(SP) ;Save the start address CMPB (R4)+,(R4)+ ;Point beyond preliminary characters MOV CURROW,R0 ;Get current row number TSTB D$OM ;Origin mode set? BEQ 40$ ;Branch if no INC R0 ;Add a line SUB TOPROW,R0 ;Subtract TOPROW to get offset from top 40$: CALL DECNUM ;Cnvt value to decimal representation (ASCII) MOVB #<';>,(R4)+ ;Include seperator in reply string MOV CURCOL,R0 ;Get current column number CALL DECNUM ;Cnvt value to decimal representation (ASCII) MOVB #<'R>,(R4)+ ;Final character in string CLRB @R4 ;End of string MOV (SP)+,R3 ;R3 = reply buffer address CALL SNDREP ;Send the reply 45$: TSTB (R2)+ ;Point to next parameter in buffer CMP R2,EBPTR ;End of buffer input? BNE 30$ ;Branch back to process the parameter CALLR CLRFLG ;Init escape flags and reset pointers ;+ ;DA ;Device attributes. Report the device type. ;Format: ; ; CSI 0c ; or [0c ; ;The default parameter is 0, so [c is also valid. ;- DA: CALL NOPARM ;Set pointers to escape parameter buffers TSTB @R2 ;Device attribute request? BNE 55$ ;Branch if no MOV #S$DRP2,R3 ;Point to secondary DA message $REL .-2,S$DRP2,PI CMPB SEQINT,#<'>> ;Secondary DA? BEQ 50$ ;Branch if yes TSTB SEQINT ;Primary DA? BNE 55$ ;Branch if error MOV #C.REPL,R3 ;Point to primary DA message $REL .-2,C.REPL,PIK 50$: CALL SNDREP ;Go send a reply 55$: CALLR CLRFLG ;Init escape flags and reset pointers ;+ ;Clear tabs. ;- ESCTAB: CALL NOPARM ;R2 -> parameter buffer MOV #TABSTP,R3 ;R3-> tab stop table $REL .-2,TABSTP,PIV TSTB @R2 ;Zero value? BEQ 65$ ;Branch if 0 CMPB #3,@R2 ;Is the value a 3? BNE 70$ ;Branch if not (ignore) - error ;+ ;Value 3. Clear all tab stops. ;- MOV MAXCOL,R1 ;Get number of tabstops to clear the buffer 60$: CLRB (R3)+ ;Clear possible tab stop SOB R1,60$ ;Loop until buffer cleared BR 70$ ;Clear flags and return ;+ ;Clear tab stop at cursor position. ;- 65$: ADD CURCOL,R3 ;Point to current position within table CLRB @R3 ;Clear tab stop 70$: CALLR CLRFLG ;Init escape flags and reset pointers .DSABL LSB .SBTTL SNDREP - send response routine ;+ ;SNDREP ; ;Enters R3 = address of reply string to be sent to the keyboard ;- .ENABL LSB SNDREP: MOV R3,KB$COM ;Set buffer address into communications word MOV #,@#CNTRL0 ;Enable keyboard input interrupts MOV #,@#CNTRL0 ;Force a keyboard interrupt RETURN .DSABL LSB .SBTTL Set/Reset mode processing .ENABL LSB ;+ ;RM - Reset mode. Clears mode byte corresponding to requested mode. ;Format: ; ESC [ Ps ; ... ; Ps l ; ;SM - Set mode. Sets mode byte corresponding to requested mode. ;Format: ; ESC [ Ps ; ... ; Ps h ; ;The following are private modes (where '?' immediatily follows '[' in ;sequence): ; ; Parameter Mode state ; --------- ---------- ; 1 Cursor key mode ; 2 VT52/VT100 (not implemented - ignored) ; 3 Column mode ; 4 Scrolling mode ; 5 Screen mode ; 6 Origin mode ; 7 Auto wrap mode ; 8 Auto repeat mode ; 9 Interlace mode ; 25 Text cursor mode ; 39 Function key mode ; ;The following are general modes (where '?' does not immediatily follow '[' in ;sequence): ; ; Parameter Mode state ; --------- ---------- ; 4 Insert/replacement line mode ; 20 New line mode ; ;Mode types may not be mixed. Mode setting/resetting is processed in the ;order they were sent (as stored in the escape parameter buffer). Unrec- ;ognized parameters are ignored. ;- SETRES: CALL NOPARM ;Set the default parameter if not specified MOV EBPTR,R1 ;Get address of end of buffer SUB R2,R1 ;Get number of arguments recieved MOV EBPTR,R2 ;Point to end of buffer to process backwards TSTB DECMOD ;Private mode? BNE 10$ ;Branch if yes CMPB -(R2),#20. ;Linefeed/new line set/reset? BNE 5$ ;No, ignore for error MOVB R3,A$LNM ;Set linefeed/newline mode 5$: SOB R1,5$ ;Loop until done BR RET 10$: CLR (PC)+ ;Clear count word VALCNT: .WORD 0 ;Contains the number of parameters in this seq 15$: CLR R4 ;Set up temp accumulater BISB -(R2),R4 ;Get sequence value BEQ 30$ ;Branch if 0 MOV #ENTTBL,R0 ;Get table start of sequence entry points $REL .-2,ENTTBL,PI 20$: TSTB @R0 ;End of list? BEQ 30$ ;Branch out if yes CMPB R4,(R0)+ ;Does the parameter match the table value? BEQ 25$ ;Branch if there is a match TSTB (R0)+ ;Point to next table value BR 20$ ;Go back through loop 25$: CLR -(SP) ;Prepare R2 to receive bias BISB @R0,@SP ;Get offset to routine ASL @SP ;Make it a byte displacement ADD #ENTTBL,@SP ;Add in start of table $REL .-2,ENTTBL,PI INC VALCNT ;Increment number of values in this sequence 30$: SOB R1,15$ ;Loop until done TST VALCNT ;Were there any valid parameters BEQ RET ;Branch out if no CALL STPCUR ;Stop cursor blink 35$: CALL @(SP)+ ;Process one of the sequences DEC VALCNT ;Decrement count of parameters in this seq. BNE 35$ ;Loop till done RET: CALLR CLRFLG ;Init escape flags and reset pointers ENTTBL: .BYTE 1,/2 ;1 - Cursor key mode .IF NE MMG$T ;If XM .BYTE 3,/2 ;3 - Column mode .ENDC ;NE MMG$T .BYTE 4.,/2 ;4 - Scroll mode .BYTE 5.,/2 ;5 - Screen mode .BYTE 6.,/2 ;6 - Origin mode .BYTE 7.,/2 ;7 - Wrap around mode .BYTE 8.,/2 ;8 - Auto repeat mode .BYTE 9.,/2 ;9 - Interlace mode .BYTE 25.,/2 ;25 - Text cursor mode .BYTE 39.,/2 ;39 - Function key mode .WORD 0 ;End of table DECCKM: MOVB R3,D$CKM ;Application/cursor mode RETURN DECCOL: CLR EOLFLG ;Reset end of line flag .IF NE MMG$T ;If XM MOV #12.,CHRWID ;Assume 80 column MOV #79.,MAXCOL ;Store number of columns MOVB R3,D$COLM ;Set column mode flag byte BEQ 40$ ;Setting to 80 column MOV #7,CHRWID ;Set character height for 132 MOV #131.,MAXCOL ;Store number of columns (0 bias) .ENDC ;EQ MMG$T 40$: MOV #CHRCEL,R1 ;Point to start of character cell table $REL .-2,CHRCEL,PIV MOV #CELWRD,R3 ;Get number of words in the character cell MOV #,R0 ;Set up register for blank fill of cell 45$: MOV R0,(R1)+ ;Move character into cell SOB R3,45$ ;Loop until buffer filled CALLR CLRSCR ;Yes, clear the screen ;+ ;DECSCL ;Change the state of scrolling mode between Jump (reset) and smooth (set) ;scrolling ;- DECSCL: ;*** NO SMOOTH SCROLL *** CLR D$SCLM ; MOV R3,D$SCLM ;= jump;<> smooth (set later to direction) ;*** NO SMOOTH SCROLL *** RETURN DECSCN: CMPB R3,D$SCNM ;Is requested background already set? BEQ 55$ ;Branch if yes, no need to refresh MOV VD$X(R5),-(SP) ;Save x register MOV VD$Y(R5),-(SP) ;Save y coordinate MOV CURCOL,-(SP) ;Save current column number MOV CURROW,-(SP) ;Save current row number CLR CLRPAT ;Assume background is dark MOVB R3,D$SCNM ;Reverse/normal screen BEQ 50$ ;Branch if background is dark COM CLRPAT ;Make background light 50$: CALL CLR1 ;Clear the screen MOV #CHRLIN-1,R3 ;Displaying full screen CALL REFRSH ;Refresh the screen MOV (SP)+,CURROW ;Restore current row number MOV (SP)+,CURCOL ;Restore the current column number MOV (SP)+,VD$Y(R5) ;Restore the y coordinate MOV (SP)+,VD$X(R5) ;Restore the y corrdinate CLR PRVCHR ;Initialize previous character word 55$: RETURN ;+ ;DECOM ;Origin mode - Change the state of Origin mode between absolute (reset ;state) and displaced (set state) mode. ;- DECOM: CLR PRVCHR ;Initialize previous character word CLR EOLFLG ;Reset end of line flag CLR VD$X(R5) ;Reset column (y coordinate) CLR CURCOL ;Clear current column number CLR VD$Y(R5) ;Reset line (x coordinate) assume reset CLR CURROW ;Clear row number MOVB R3,D$OM ;Relative/absolute origin BEQ 60$ ;Branch if reset origin mode (absolute) MOV TOPROW,CURROW ;Update current row number MOV CURROW,R1 ;Set up for MUL routine MUL CHRHIG,R1 ;Convert current row to y coordinate MOV R1,VD$Y(R5) ;Store in y register 60$: RETURN DECAWN: MOVB R3,D$AWM ;Wraparound mode RETURN DECARM: MOVB R3,D$ARM ;Auto repeat mode .IF NE MMG$T CALL MAPKBD ;Map PAR1 to ARPT routine (PIK) .ENDC ;NE MMG$T MOVB #PR4,@#PS ;Protect ARPT from others CALL @#ARPT ;Turn auto repeat on/off as indicated $REL .-2,ARPT,PIK CLRB @#PS ;Unprotect ARPT; we're done with it RETURN ;Unmap ARPT (PIK) and return DECINT: MOV VD$CSR(R5),-(SP) ;Get old contents of CSR BIC #,VD$CSR(R5) ;Assume we are turning interlace ;off. In either case make sure 480 interlace ;mode is off MOVB R3,D$INT ;Interlace mode BEQ 65$ ;Branch if assumption correct - no interlace BIS #,VD$CSR(R5) ;Set interlace bit on 65$: BIT #,(SP)+ ;Was 480 interlace mode set? BEQ 70$ ;Branch if no CALLR RISTAT ;Else reset screen and variables DECTCE::MOVB R3,D$CUR ;Text cursor mode BNE 70$ ;Branch if turning cursor on CALLR CLRCUR ;Clear the cursor DECFKM: MOVB R3,D$FKM ;Function key mode 70$: RETURN .DSABL LSB .SBTTL Erase routines .ENABL LSB ESCECP: CALL STPCUR ;Stop cursor blink JSR R4,CHKCHR ;Check for character match .CHRDIS J,ED ;Erase in display .CHRDIS K,EL ;Erase in line .WORD 0 BCC 5$ ;Branch if found and processed CALL CURPOS ;See if we have a position cursor sequence 5$: RETURN ;+ ;ERASE in display or line ; ;ED - Erase character positions within the display. ;Formats are: ; ; CSI (233) Ps ; ... ; Ps J ; or ESC[ Ps ; ... ; Ps J ; ;EL - Erase character positions within the line. ;Formats are: ; ; CSI (233) Ps ; ... ; Ps K ; or ESC[ Ps ; ... ; Ps K ; ;In all cases ,ED and EL, the active cursor position is included in the ;erase function. The dafault value is also 0. ; ; ;0 or default = from active cursor position to end of display or line ;1 = from top of display or line to active cursor position ;2 = full display or current line ; ;Parameters are processed as entered in the sequence (as stored in the ;parameter buffer. Sets line attributes to single width. ;- ED: CLR R3 ;Flag 0 if erase in display EL: MOV R3,-(SP) ;Save erase type flag <> in line ; = in disply CALL NOPARM ;Set the default parameter if none specified MOV R2,R3 ;R1 -> start of escape buffer for convenience 10$: CMPB @R3,#2 ;Is it a valid parameter? BGT 25$ ;Branch if yes no operation CALL CLRPRT ;Clear a partial line TST @SP ;What type of erase is taking place? BNE 15$ ;Branch if erase in line CALL REGCLR ;Clear rest of region in specified direction BR 20$ ;Join common routine 15$: DECB @R3 ;Check value parameter BNE 20$ ;Branch if partial line CLR R0 ;Flag to clear entire line CALL CLRREG ;Clear entire line 20$: CLR EOLFLG ;Reset end of line flag 25$: INC R3 ;R3 -> next parameter CMP R3,EBPTR ;End of parameters? BLT 10$ ;Branch to the start if not TST (SP)+ ;Clean up stack before returning CALLR CLRFLG ;Init escape flags and reset pointers .DSABL LSB .ENABL LSB CURPOS: JSR R4,CHKCHR ;Check for character match .CHRDIS f,HVP ;Horizontal/vertical position .CHRDIS H,CUP ;Cursor position .CHRDIS r,DECSTB ;Scrolling region .CHRDIS A,CUU ;Cursor up .CHRDIS B,CUD ;Cursor down .CHRDIS C,CUF ;Cursor forward .CHRDIS D,CUB ;Cursor backward .WORD 0 RETURN ;+ ;HVP - Horizontal/vertical position ;CUP - Cursor position ; ;Both HVP and CUP are identical. Only the escape sequence format differs. ;This routine moves the active position to an absolute line and column ;address as specified by the parameter values. The first parameter specifies ;the new line address, and the second specifies the new column address. If ;either parameter is omitted or explicitly set to zero, that parameter value ;is defaulted to one. ;HVP format: ; ; CSI Pl ;Pc f ; or [ Pl ; Pc f ;CUP format: ; ; CSI Pl ;Pc H ; or [ Pl ; Pc H ; ;This control is affected by the setting of Origin mode. If Origin mode is ;reset, addressing is performed relative to the screen origin (first column ;in the first line). If Origin mode is set, addressing is performed relative ;to the origin (of the current scrolling region (first column in the top ;margin). ; ;If an attempt is made to move the active position outside of the addressable ;display (Origin mode reset - full screen; Origin mode set - current ;scrolling region) it will be moved in the direction indicated to the ;boundary of the addressable area, but will not move beyond that boundary. ; ;Note that specified columns are adjusted by one for positions internally ;begin at 0. Not 1. ;- HVP: CUP: CLR PRVCHR ;Initialize previous character word CALL SETDEF ;Store default values in escape buffer MOV #CHRLIN-1,R3 ;R3 = bottom line (line 23 - bias) TSTB D$OM ;Origin mode set? BEQ 5$ ;No, use value in R1 as absolute MOV BOTROW,R3 ;R3 = bottom margin of scrolling region ADD TOPROW,R1 ;R1 relative to TOPROW 5$: CMP R1,R3 ;Specified row beyond bottom region? BLE 10$ ;No, use what's in R1 MOV R3,R1 ;Use bottom most row coordinate 10$: MOV R1,R0 ;Save current row ASL R0 ;Make current line number a offset into LINCEL MOV R1,CURROW ;Update current row number MUL CHRHIG,R1 ;Convert line number to y coordinate MOV R1,VD$Y(R5) ;Store new value into y coordinate register CLR R1 ;Set R1 for use BISB (R2)+,R1 ;Get column value BEQ 15$ ;Branch if equal - first column internally DEC R1 ;Adjust for 0 to 79/131 15$: BIT #,LINCEL(R0) ;Double wide line? $REL .-2,LINCEL,PIV BEQ 20$ ;Branch if no ASL R1 ;Double for double wide 20$: CMP R1,MAXCOL ;Beyond end of screen? BLE 25$ ;Branch if no MOV MAXCOL,R1 ;Yes, set column to last BIT #,LINCEL(R0) ;Double wide line? $REL .-2,LINCEL,PIV BEQ 25$ ;Branch if single DEC R1 ;Must adjust for odd column number 25$: MOV R1,CURCOL ;Update current column count MUL CHRWID,R1 ;Convert column number to x coordinate MOV R1,VD$X(R5) ;Set new coordinate in x register CLR EOLFLG ;Reset end of line flag RETURN ;+ ;DECSTB ;Scrolling region - Set top and bottom margins, defining the scrolling region. ;The first parameter defines the top margin and the second argument is the ;bottom margin. The defaults for the parameters are 1 and 24 for top and ;bottom. If the bottom is higher than the top error occurs and the sequence ;is ignored. ;- DECSTB: CALL SETDEF ;Store default values in escape buffer TSTB @R2 ;Was second parameter defaulted or 0? BNE 30$ ;Branch if no MOVB #,@R2 ;Set second default parameter to default 24 30$: CMPB -1(R2),@R2 ;Is first less than second? BHIS 40$ ;No, error CMPB @R2,# ;Larger than valid number lines on the screen? BHI 40$ ;Yes, error. Ignore sequence. MOV R1,(PC)+ ;Set top line (first line number in region) TOPROW:: .WORD 0 ;Top line (first line number in region) MUL CHRHIG,R1 ;Convert to scan line (y coordinate) MOV R1,(PC)+ ;Store it TOPLIN:: .WORD 0 ;Y coordinate for top row CLR R1 ;Set up to recieve parameter BISB @R2,R1 ;Get specified value (for high byte) DEC R1 ;Set row value bias MOV R1,(PC)+ ;Set bottom line (line # bottom in region) BOTROW:: .WORD CHRLIN-1 ;Bottom line number of region) MUL CHRHIG,R1 ;Convert to scan lines MOV R1,(PC)+ ;Store in BOTLIN BOTLIN:: .WORD *CHRTMP ;Scan line bottom *** INITIALLY 240 MODE *** CLR CURCOL ;Clear current column number CLR VD$X(R5) ;Clear column number (x coordinate) CLR R1 ;Set current row to 0 TST D$OM ;Origin mode set? BEQ 35$ ;Branch if no MOV TOPROW,R1 ;Update current row to be top line number 35$: MOV R1,CURROW ;Update current row number MUL CHRHIG,R1 ;Convert to y coordinate MOV R1,VD$Y(R5) ;Store in y register CLR EOLFLG ;Reset end of line flag CLR PRVCHR ;Initialize previous character word 40$: RETURN ;+ ;Cursor positioning. ;Set bit definition for position ;- .ASSUME C$UB EQ 1 .ASSUME C$UU EQ 2 .ASSUME C$UF EQ 4 .ASSUME C$UD EQ 10 CUD: ASL R3 ;Cursor down (C$UD) CUF: ASL R3 ;Cursor forward (C$UF) CUU: ASL R3 ;Cursor up (C$UU) CUB: ;Cursor backward (C$UB) CALL NOPARM ;Set up pointers to parameter buffer MOV CURROW,R0 ;Get current row number ASL R0 ;Make row number an offset CLR -(SP) ;Set double flag to single MOV #LINCEL,R1 ;Point to line cell start $REL .-2,LINCEL,PIV ADD R0,R1 ;Point to entry for current row BIT #,@R1 ;Double wide line? BEQ 45$ ;Branch if no INC @SP ;Set flag to double wide line 45$: CLR -(SP) ;Make sure there is nothing there BISB (R2)+,@SP ;Get parameter value BNE 50$ ;Parameter > 0 specified INC @SP ;Set default value to 1 50$: BIT #,R3 ;Column operation? BNE 85$ ;Branch if yes CLR PRVCHR ;Initialize previous character word MOV CURROW,R1 ;Get current row number BIT #,R3 ;Cursor down routine BNE CURDWN ;Branch if yes CURUP: MOV TOPROW,R2 ;Use top margin row number SUB (SP)+,R1 ;Subtract # of lines to go up with current row BCC 55$ ;Branch if no overflow MOV R2,R1 ;Else, use top margin (row number) 55$: CMP R1,R2 ;Is calculated row within top margin? BGE 70$ ;Branch if yes BR 65$ ;Else, set row to top margin (row number) CURDWN: MOV BOTROW,R2 ;Else set boundary check to bottom margin ADD (SP)+,R1 ;Add # of lines to move down from current row BCC 60$ ;Branch if no overflow MOV R2,R1 ;Else set to bottom margin 60$: CMP R1,R2 ;Below the bottom margin? BLE 70$ ;Branch if no 65$: MOV R2,R1 ;Yes, set to bottom margin 70$: MOV R1,CURROW ;Store current row MOV R1,-(SP) ;Save current row MUL CHRHIG,R1 ;Convert to y coordinate MOV R1,VD$Y(R5) ;Store new coordinate into register MOV #LINCEL,R1 ;R1 -> Line cell table entry $REL .-2,LINCEL,PIV ASL @SP ;Make offset to table ADD @SP,R1 ;Point to new line cell entry CLR @SP ;Set up flag word BIT #,@R1 ;Double wide line? BEQ 75$ ;Branch if no INC @SP ;Set flag to denote double wide line 75$: MOV CURCOL,R1 ;Get current column number CMP (SP)+,(SP)+ ;Renditions of the new and old line the same? BEQ 110$ ;Branch if yes BLT 80$ ;Branch if double to single ASL R1 ;Double current column number BR 95$ ;Join common routine to store new column 80$: ASR R1 ;Cut current column in half BR 105$ ;Join common routine to store new column 85$: MOV (SP)+,R2 ;Get number of columns to move over TST (SP)+ ;Double <>; single = line width BEQ 90$ ;Branch if single ASL R2 ;Double parameter 90$: MOV CURCOL,R1 ;Get current column BIT #,R3 ;Cursor forward request? BNE CURFOR ;Branch if yes CURBAC: SUB R2,R1 ;Sub. reqested columns from current columns BCC 105$ ;Branch if no overflow CLR R1 ;Else, set to start of row BR 105$ ;Go store new coordinate in x resister CURFOR: ADD R2,R1 ;Add requested columns to current columns BCS 100$ ;Branch if overflow 95$: CMP R1,MAXCOL ;Beyond end of line? BLE 105$ ;Branch if no 100$: MOV MAXCOL,R1 ;Else set cursor to end of line MOV CURROW,R2 ;Get current row ASL R2 ;Make it an offset BIT #,LINCEL(R2) ;Double wide column? $REL .-2,LINCEL,PIV BEQ 105$ ;Branch if no DEC R1 ;Adjust column down 105$: MOV R1,CURCOL ;Update current column number MUL CHRWID,R1 ;Convert current number to a coordinate MOV R1,VD$X(R5) ;Set new x coordinate into x register 110$: CLR EOLFLG ;Reset end of line flag RETURN .DSABL LSB .ENABL LSB REGCLR: CLR R1 ;Assume clearing from top of screen MOV SCNLIN,R2 ;Get y coordinate of last line TSTB @R3 ;What type of clear is in progress? BGT 10$ ;Clear display - convert to words to clear BEQ 5$ ;Clear from top to active cursor position MOV @R4,R1 ;Get current row SUB R1,R2 ;R2 = # lines from active position to bottom BLE 25$ ;Branch if already at bottom ADD CHRHIG,R1 ;Clear line following active row BR 10$ ;Compute number of words 5$: MOV @R4,R2 ;Get current line (top of row) BEQ 25$ ;Branch if top of screen 10$: .REPT 6 ;Number of lines to clear * 64 ASL R2 .ENDR MOV R2,-(SP) ;Save number of lines MOV R1,-(SP) ;Save y coordinate MOV #<-1>,R0 ;Flag to clear area CALL CLRREG ;Clear rest of area CLR R0 ;Set up for DIV instruction MOV (SP)+,R1 ;Get y coordinate that clear began on DIV CHRHIG,R0 ;Convert to row number MOV R0,R2 ;Store it ASL R2 ;Make it an offset CLR R0 ;Set up for DIV instruction MOV (SP)+,R1 ;Clear lines from above DIV ROWWRD,R0 ;Convert to number of cleared lines MOV R3,-(SP) ;Save R3 15$: MOV MAXCOL,R3 ;Get number of maximum columns INC R3 ;Make it count MOV #CELSTR,R1 ;R1 -> character cell vector area $REL .-2,CELSTR,PIV ADD R2,R1 ;Point to vector for current line MOV @R1,R1 ;Point to start of cell entries for row MOV #BLANK,-(SP) ;Get character cell entry to store 20$: MOV @SP,(R1)+ ;Initialize character cell entry SOB R3,20$ ;Loop until done TST (SP)+ ;Clean off stack TST (R2)+ ;Bump offset SOB R0,15$ ;Loop until done MOV (SP)+,R3 ;Restore R3 25$: RETURN .DSABL LSB .SBTTL CLRPRT - Clear partial line ;+ ;CLRPRT ;Routine is called by both the erase in line and display. This routine ;clears columns in only the current row. The corresponding cell entries ;in the character cell buffer are also cleared. If entered with a argument ;of 2 (erase full line) control returns to calling routine. Renditions ;are not effected by the operations of this routine. ; ;Enters: R3 contains direction determination flag (see comments in EL and ED ; routine) ;- .ENABL LSB CLRPRT: MOV R5,R4 ;R4 = controller address ADD #VD$Y,R4 ;R4 -> y controller register DECB @R3 ;Decrement the value BGT 45$ ;Branch if 2 command BIC #VDOCD$,VD$CSR(R5) ;Clean out writable bits BIS VDMBTC,VD$CSR(R5) ;Bits top to bottom MOV -(R4),-(SP) ;Save x coordinate TSTB @R3 ;Clearing to start or to end of line? BEQ 15$ ;Branch if clearing to start of line ;+ ;Start to end ;- MOV @R4,R2 ;Get saved x coordinate NEG R2 ;Negate for counter to word boundary BIC #^C<17>,R2 ;R3 = number of bits forward to word boundary BEQ 10$ ;Branch if already there MOV CHRHIG,R0 ;Number of lines in row 5$: CALL CLRPLN ;Set appropriate planes and clear INC @R4 ;Move to next column SOB R2,5$ ;Branch till done 10$: MOV #2000,R0 ;R0 = number of columns in screen (VDLWI.) SUB (R4)+,R0 ;R0 = number of columns to right of screen ;R4 -> y coordinate BR 30$ ;Word clear to end ;+ ;From current pointer to end ;- 15$: ADD CHRWID,@R4 MOV @R4,R2 ;Current x coordinate BIC #^C<17>,R2 ;Number of bits backward to word boundary BEQ 25$ ;Branch if already there MOV CHRHIG,R0 ;Number of lines in row 20$: DEC @R4 ;Go to previous column CALL CLRPLN ;Set appropriate planes and clear SOB R2,20$ ;Branch till done 25$: MOV (R4)+,R0 ;Get number of columns to left margin BEQ 40$ ;Branch if already there CLR VD$X(R5) ;Set to left most column 30$: ASR R0 ;Divide number of columns by 16 ASR R0 ;...to get number of words to clear ASR R0 ; ASR R0 ; BIC #,VD$CSR(R5) ;Clean out writable bits BIS VDMWLC,VD$CSR(R5) ;Word left to right MOV CHRHIG,R2 ;Number of lines DEC R2 ;Must be number of lines minus 1 ADD R2,VD$Y(R5) ;Move to bottom line of this row CALL CLRPLN ;Set appropriate planes and clear 35$: DEC @R4 ;Move up to previous line (y register) CALL CLRPLN ;Set appropriate planes and clear SOB R2,35$ ;Clear entire row 40$: MOV (SP)+,VD$X(R5) ;Restore old x coordinate 45$: CLR R1 ;Assume clearing from beginning of line MOV MAXCOL,R2 ;Assume clearing to end of line TSTB @R3 ;What type of clear is it? BGT 55$ ;Branch if from beginning to end of line (2) BEQ 50$ ;Branch if beginning of line to active pos (1) MOV CURCOL,R1 ;Act pos to end (0) get cursor position BR 55$ ;Join common routine 50$: MOV CURCOL,R2 ;Set end positon as current column 55$: SUB R1,R2 ;Calculate number of locations to initialize CLR -(SP) ;Initialize reset line cell flag CMP R2,MAXCOL ;Initializing full line? BNE 60$ ;Branch if not TST 4(SP) ;Erase display or line? BNE 60$ ;Erase in line INC @SP ;Set flag to initialize line cell 60$: INC R2 ;Adjust count BEQ 70$ ;Branch if at end MOV #CELSTR,R0 ;R1 -> character cell vector area $REL .-2,CELSTR,PIV ADD CURROW,R0 ;Point to vector for current row ADD CURROW,R0 ; MOV @R0,R0 ;Get start of character cell entry for row ADD R1,R0 ;Point to current character cell entry ADD R1,R0 ; MOV #BLANK,R1 ;Initialize cell with space 65$: MOV R1,(R0)+ ;Initialize character cell entry SOB R2,65$ ;Loop until done 70$: TST (SP)+ ;Reset line cell? BEQ 75$ ;Branch if no MOV CURROW,R1 ;Get current row number ASL R1 ;Make it a offset BIC #,LINCEL(R1) ;Initialize line cell entry $REL .-2,LINCEL,PIV 75$: RETURN .DSABL LSB .SBTTL CLRSCR - Clear screen ;+ ;CLRSCR ;Routine to clear the screen and reset cursor position to top of screen. ; ; R5 -> Base address of video registers. ;- .ENABL LSB CLRSCR::MOV #LINCEL,R0 ;R0 -> line attribute table $REL .-2,LINCEL,PIV MOV #CHRLIN,R1 ;R1 = number of line words to clear 5$: BIC #,(R0)+ ;Reset line attributes SOB R1,5$ ;Loop until done CLR1: BIC #,VD$CSR(R5) ;Clean out writable bits BIS VDMWLC,VD$CSR(R5) ;Set up for word left to right CLR VD$X(R5) ;Clear x coordinate CLR CURCOL ;Clear current column number CLR VD$Y(R5) ;Clear y coordinate CLR CURROW ;Clear current row number CLR PRVCHR ;Initialize previous character word MOV #<40000>,R0 ;Get default number of words in memory (240) TST (PC)+ ;Is this a PRO380? PRO380:: .WORD 0 ;0 => PRO350; non-0 => PRO380 BEQ 10$ ;Branch if not ASL R0 ;More memory to clear if PRO380 10$: CALLR CLRPLN ;Set appropriate planes and clear .DSABL LSB .ENABL LSB REFRSH: ;+ CALL SCWAIT ;Wait for scrolling to finish ;- MOV VD$Y(R5),S1VD$Y ;Save y coordinate (register) MOV R3,-(SP) ;Save last row + 1 to display MOV CURROW,R3 ;Get first row to display BEQ 5$ ;Branch if no need to issue a MUL MUL CHRHIG,R3 ;Get y coordinate 5$: MOV R3,VD$Y(R5) ;Store it in y register 10$: CLR PRVCHR ;Initialize previous character word MOV CURROW,R1 ;Get current row number ASL R1 ;Make it an offset MOV CELSTR(R1),R1 ;R1 -> first character cell for current row $REL .-2,CELSTR,PIV CLR CURCOL ;Start at beginning CLR VD$X(R5) ;Reset x register 15$: MOV R1,-(SP) ;Save pointer to character cell entry CALL DSPCHR ;Display the character MOV (SP)+,R1 ;Restore cell pointer TST (R1)+ ;Bump it to next entry TST EOLFLG ;Last character in line entered? BEQ 15$ ;Branch if no CLR EOLFLG ;Re initialize end of line flag CMP CURROW,@SP ;Have all rows been redisplayed? BEQ 20$ ;Branch until done ADD CHRHIG,VD$Y(R5) ;Bump line register INC CURROW ;Update current row count BR 10$ 20$: CLR PRVCHR ;Initialize previous character word TST (SP)+ ;Pop off stack MOV S1VD$Y,VD$Y(R5) ;Restore y coordinate RETURN .DSABL LSB .SBTTL CLRPLN - CLEAR function ;+ ;CLRPLN ;Subroutine for clear word or bits. If no EBO, just clear through plane 1. ;If EBO present, clear through all 3 planes. With no EBO, use of OPC register ;is a NOP. ; ;Input: R0 = contains word or bit count to clear for count register. ; ;Call: CALL CLRPLN ;Set appropriate planes and clear ; or ; CALLR CLRPLN ;Set appropriate planes and clear ; ;Output: no change. ;- .ENABL LSB CLRPLN::TST VD$CSR(R5) ;Transfer done? BPL CLRPLN ;Branch if not MOV VD$OPC(R5),-(SP) ;Save plane 2 and 3 control register MOV (PC)+,-(SP) ;Enable plane 2 and 3 along with command .BYTE , ;Set screen to pattern ;register for both plane 2 ;and 3 and enable both planes ;+ MOV CLRPAT,$VDPAT ;- MOV CLRPAT,VD$PAT(R5) ;Set pattern to clear BEQ 10$ ;Branch if in dark mode MOV (PC)+,@SP ;Set screen to reverse of pattern register .BYTE , ;Least significant bit set 10$: MOV (SP)+,VD$OPC(R5) ;Set in OPC register MOV R0,VD$CNT(R5) ;Set count register with bits to clear column 15$: TST VD$CSR(R5) ;Done with clear? BPL 15$ ;Branch if not MOV (SP)+,VD$OPC(R5) ;Restore plane 2/3 control register RETURN .DSABL LSB .SBTTL CLRFLG - Initialize escape flags and buffers ;+ ;CLRFLG ;Initialize escape processing flags and restore the escape parameter buffer ;pointer to the start of the buffer. ; ; CALL CLRFLG ;Initialize all escape flags and buffers ; ; R1 is changed ;- .ENABL LSB CLRFLG: ;+ CALL SCWAIT ;Wait for scrolling to finish ;- MOV VD$Y(R5),ROWYCO ;Update real y coordinate value CLRFL: CLRB ESCPRO ;Escape processing flag CLRB ESCTYP ;Escape type flag CLRB DECMOD ;Private mode flag CLRB QFLAG ;Question mark flag CLRB ESCEND ;End sequence flag CLR SEQINT ;Intermediate character flag word CLR ESCERR ;Escape error flag CLR VALFLG ;Clear value in progress flag word (ESCLBR) CLR OVRERR ;Clear overflow flag word (ESCLBR) CLR ACCUM ;Clear saved accumulater (ESCLBR) MOV #ESCBUF,EBPTR ;Restore parameter buffer pointer $REL .-4,ESCBUF,PI MOV EBPTRE,DEFBUF ;Address is also start of default flag buffer RETURN .DSABL LSB .SBTTL Cursor routines .ENABL LSB BLICUR: TST VD$CSR(R5) ;Transfer done? BPL 30$ ;Branch if no TST CURGO ;Blink disabled? BNE 30$ ;Branch if yes TST BYESCR ;End of blank screen count? BNE 5$ ;Branch if no MOV #,VD$P1C(R5) ;Turn off the display BR 30$ ;Branch out 5$: DEC BYESCR ;Decrement heart beats left MOVB #21.,CURSCT ;Set cursor off count TSTB D$CUR ;Cursor allowed to blink? BEQ 30$ ;Branch if no TSTB CURSON ;Is cursor on? BNE 10$ ;Branch if no ASLB CURSCT ;Add more for cursor on time BR 10$ ;Go blink STPCUR::TST CURGO ;Is cursor already off BNE 30$ ;Branch if yes COM (PC)+ ;Turn off cursor blink CURGO: .WORD 0 ;<> disables cursor blink (stops blink) CLRCUR: BIC (PC)+,(PC)+ ;Display cursor next time around .BYTE 377 ;Clear blink count .BYTE 0 ;Don't clear on/off byte CURSOR: ;Word offset for both flags CURSCT: .BYTE 0 ;Blink counter CURSON: .BYTE 0 ;<> for cursor on, = for off BEQ 30$ ;Return if cursor off 10$: BIC #VDOCD$,VD$CSR(R5) ;Clean out writable bits BIS VDMBLC,VD$CSR(R5) ;Set bit mode left to right MOV #,VD$P1C(R5) ;Complement plane ;+ MOV $VDPAT,-(SP) MOV #-1,$VDPAT ;- MOV #-1,VD$PAT(R5) ;XOR pattern to complement MOV VD$Y(R5),S2VD$Y ;Save y coordinate MOV CHRHIG,R2 ;Get loop count MOV R0,-(SP) ;Save R0 MOV R1,-(SP) ;Save R1 MOV CHRWID,R0 ;Get character width MOV CURROW,R1 ;Get current row ASL R1 ;Make it an offset BIT #,LINCEL(R1) ;What is the line rendition? $REL .-2,LINCEL,PIV BEQ 15$ ;Branch if single wide ASL R0 ;Double wide - double size of cursor 15$: TSTB S$CURR ;Block or underline cursor? BEQ 20$ ;Branch if block MOV #1,R2 ;Set count to 1 ADD #CHRTMP-2,VD$Y(R5) ;Set underline for next to last line BIT #,VD$CSR(R5) ;240 or 480 line mode? BEQ 20$ ;Branch if 240 INC R2 ;Double the count for two lines SUB #2,VD$Y(R5) ; and adjust Y coordinate for next to last ; line in 480 mode. 20$: MOV R0,VD$CNT(R5) ;Display it INC VD$Y(R5) ;Increment line count 25$: TST VD$CSR(R5) ;Transfer done? BPL 25$ ;Branch if no SOB R2,20$ ;Loop until done MOV (SP)+,R1 ;Restore R1 MOV (SP)+,R0 ;Restore R0 MOV S2VD$Y,VD$Y(R5) ;Restore y coordinate COMB CURSON ;Indicate cursor complemented ;+ MOV @SP,$VDPAT MOV (SP)+,VD$PAT(R5) ;- MOV PLCONV,VD$P1C(R5) ;Restore plane control register 30$: RETURN .DSABL LSB .SBTTL SCROLL - Scrolling routine ;+ ;SCROLL ;Check if it is necessary to scroll. If not just adjust the y coordinate. ;If scrolling is needed, determine if split screen or full screen scrolling ;is needed. ;- .ENABL LSB SCROLL::CLR PRVCHR ;Initialize previous character word MOV BOTROW,R4 ;Get current row number SUB TOPROW,R4 ;Get number of rows to adjust CMP VD$Y(R5),BOTLIN ;At bottom line? BGT 20$ ;Branch if below - set up scroll BLT 45$ ;Branch if above - no scrolling CMP R4,#CHRLIN-1 ;Full screen? BNE 5$ ;Branch if no TST D$SCLM ;Full screen scroll - jump or smooth? BNE 30$ ;Branch if smooth - move below visible area CALL VECUP ;Update the row vector pointers MOV VD$SCL(R5),-(SP) ;Get current contents of scroll register ADD CHRHIG,@SP ;Jump scroll up one row BIC SCLMSK,@SP ;Remove extraneous bits MOV (SP)+,VD$SCL(R5) ;Scroll up by one line MOV MLISL,R1 ;Get memory length in scan lines SUB CHRHIG,R1 ;Set y coordinate for clear MOV R1,R0 ;Flag for scroll clear (R0 <> but positive) CALLR CLRREG ;Clear row scrolled out ;+ ;Split screen. ;- 5$: CALL VECUP ;Update the row vector pointers .IF EQ MMG$T ;If FB MOV VD$X(R5),-(SP) ;Save x coordinate MOV CURCOL,-(SP) ;Save current column count MOV CURROW,-(SP) ;Save current row number MOV TOPROW,CURROW ;Set top of scl region as current row number CLR VD$X(R5) ;Initial x coordinate register CLR CURCOL ;Initial current column number MOV BOTROW,R3 ;Get last row of scrolling region INC R3 ;BOTROW+1 for REFRSH routine CALL REFRSH ;Refresh portion of screen for scroll .IFF ;If XM MOV BOTROW,R1 ;Get bottom row number MOV TOPROW,R3 ;Get current row SUB R3,R1 ;Get number of rows to move MUL WDCHNK,R3 ;Multiply by chunks ADD #,R3 ;PAR value MOV @#KISAR1,-(SP) ;Save current kernel mapping MOV R3,@#KISAR1 ;Set new kernal mapping MOV #,VD$P1C(R5) ;Enable plane 1 bitmap 10$: MOV #,R2 ;Set address to write to MOV PXLRAD,R4 ;Get address of line to move ADD R2,R4 ; MOV PXLLPC,R0 ;Number of words in line to move (loop count) 15$: .REPT 8. MOV (R4)+,(R2)+ ;Move bitmap words for a whole line .ENDR SOB R0,15$ ;Loop until text line has been moved ADD WDCHNK,@#KISAR1 ;Update the kernel mapping SOB R1,10$ ;Loop until total lines have been moved MOV (SP)+,@#KISAR1 ;Restore old kernel mapping MOV PLCONV,VD$P1C(R5) ;Reset up plane 1 control .IFTF ;Both FB and XM CLR R0 ;Flag to clear current row CALL CLRREG ;Clear current row .IFT ;If FB MOV (SP)+,CURROW ;Restore current row number MOV (SP)+,CURCOL ;Restore current column number MOV (SP)+,VD$X(R5) ;Restore x register .ENDC ;EQ MMG$T RETURN 20$: CMP R4,#CHRLIN-1 ;Full screen? BNE 40$ ;Split screen past region CALL SSWAIT ;Wait for smooth scroll 30$: CALL VECUP ;Update the row vector pointers ;*** NO SMOOTH SCROLL *** ; MOV #<-1>,D$SCLM ;Indicate scrolling direction ; BIT #,VD$CSR(R5) ;240 or 480 line mode? ; BEQ 35$ ;Branch if 240 ; DEC D$SCLM ;Make -2 for 480 line mode ;*** NO SMOOTH SCROLL *** 35$: ADD CHRHIG,VD$Y(R5) ;Move to next character row ADD CHRHIG,ROWYCO ;Move to next character row RETURN SSWAIT: CALL WAIT ;Call WAIT manager CMP VD$Y(R5),(PC)+ ;Smooth scrolling below visible area? SCRNBD:: .WORD 256.- ;Y coordinate of next to last display row ;*** Default is 240 line mode *** BGT 25$ ;Branch if yes - wait for scrolling TST (PC)+ ;We don't need to wait 25$: SEC ;Say we need to wait RETURN ;+ ;No scrolling ;- 40$: CMP CURROW,#CHRLIN-1 ;Are we at the bottom of the screen? BEQ 75$ ;Branch if yes - don't reposition pointer 45$: MOV CURROW,R0 ;Get current row number ASL R0 ;Make current row an offset value CLR -(SP) ;Set up line width flag BIT #,LINCEL(R0) ;Double width line? $REL .-2,LINCEL,PIV BEQ 50$ ;Branch if single wide INC @SP ;Set double wide rendition 50$: TST (R0)+ ;Point to next line entry in table CLR -(SP) ;Set up line width flag for new line BIT #,LINCEL(R0) ;Double width line? $REL .-2,LINCEL,PIV BEQ 55$ ;Branch if single wide INC @SP ;Set double wide rendition 55$: MOV CURCOL,R1 ;Get current column number CMP (SP)+,(SP)+ ;Same attribute of current as next line? BEQ 70$ ;Branch if yes BLT 60$ ;Branch if going from double to single ASL R1 ;Single to double - double column count CMP R1,MAXCOL ;Beyond maximum column? BLE 65$ ;Branch if ok MOV MAXCOL,R1 ;Make position the last column BR 65$ ;Convert to coordinate and store 60$: ASR R1 ;Cut column number in half 65$: MOV R1,CURCOL ;Update with new current column number MUL CHRWID,R1 ;Convert to coordinate MOV R1,VD$X(R5) ;Update x register 70$: ADD CHRHIG,VD$Y(R5) ;Move to next character row INC CURROW ;Bump the current row number 75$: RETURN .DSABL LSB .ENABL LSB BACSCL: CLR PRVCHR ;Initialize previous character word CMP VD$Y(R5),TOPLIN ;Is active position above top margin? BLT 20$ ;Branch if above top scan line BGT 25$ ;Branch if below top scan line MOV BOTROW,R4 ;Get bottom row number SUB CURROW,R4 ;Get number of rows in between CALL VECDWN ;Adjust vectors down CMP R4,#CHRLIN-1 ;Full screen? BNE 5$ ;Branch if no TST D$SCLM ;Jump or smooth? BNE 60$ ;Branch if smooth MOV VD$SCL(R5),-(SP);Get current scroll register contents SUB CHRHIG,@SP ;Set for scrolling back one line BIC SCLMSK,@SP ;Remove extraneous bits MOV (SP)+,VD$SCL(R5);Set register to do scroll MOV SCNLIN,R1 ;Set up word count for one line MOV #<1>,R0 ;Flag to clear row CALLR CLRREG ;Clear line 5$: .IF EQ MMG$T ;If FB MOV VD$X(R5),-(SP) ;Save x coordinate MOV CURCOL,-(SP) ;Save current column count MOV CURROW,-(SP) ;Save current row number MOV TOPROW,CURROW ;Set top of scl region as current row number MOV BOTROW,R3 ;Get last row of scrolling region INC R3 ;BOTROW+1 for REFRSH routine CALL REFRSH ;Refresh portion of screen for scroll .IFF ;If XM MOV BOTROW,R3 ;Get bottom row number MOV R3,R1 ;R1 = bottom row number SUB TOPROW,R1 ;Get number of rows to move MUL WDCHNK,R3 ;Multiply by chunks SUB WDCHNK,R3 ADD #,R3 ;PAR value MOV @#KISAR1,-(SP) ;Save current kernel mapping MOV R3,@#KISAR1 ;Set new kernal mapping MOV #,VD$P1C(R5) ;Enable plane 1 bitmap 10$: MOV #,R4 ;Address of line to move MOV PXLRAD,R2 ;Set address to write to ADD R4,R2 ; MOV PXLLPC,R0 ;Number of words in line to move (loop count) 15$: .REPT 8. MOV (R4)+,(R2)+ ;Move bitmap words for a whole line .ENDR SOB R0,15$ ;Loop until line has been moved SUB WDCHNK,@#KISAR1 ;Update the kernel mapping SOB R1,10$ ;Loop until all lines have been moved MOV (SP)+,@#KISAR1 ;Restore old kernel mapping MOV PLCONV,VD$P1C(R5) ;Reset up plane 1 control .IFTF ;Both CLR R0 ;Flag to clear current row CALL CLRREG ;Clear current row .IFT ;If FB MOV (SP)+,CURROW ;Restore current row number MOV (SP)+,CURCOL ;Restore current column number MOV (SP)+,VD$X(R5) ;Restore x register .ENDC ;EQ MMG$T RETURN 20$: TST VD$Y(R5) ;Top of screen? BEQ 55$ ;Branch if yes - do nothing 25$: MOV CURROW,R0 ;Get current row number ASL R0 ;Make current row an offset value CLR -(SP) ;Set up line width flag BIT #,LINCEL(R0) ;Double width line? $REL .-2,LINCEL,PIV BEQ 30$ ;Branch if single wide INC @SP ;Set double wide rendition 30$: TST -(R0) ;Point to next line entry in table CLR -(SP) ;Set up line width flag for new line BIT #,LINCEL(R0) ;Double width line? $REL .-2,LINCEL,PIV BEQ 35$ ;Branch if single wide INC @SP ;Set double wide rendition 35$: MOV CURCOL,R1 ;Get current column number CMP (SP)+,(SP)+ ;Same attribute of current as next line? BEQ 50$ ;Branch if yes BLT 40$ ;Branch if going from double to single ASL R1 ;Single to double - double column count CMP R1,MAXCOL ;Beyond maximum column? BLE 45$ ;Branch if ok MOV MAXCOL,R1 ;Make position the last column BR 45$ ;Convert to coordinate and store 40$: ASR R1 ;Cut column number in half 45$: MOV R1,CURCOL ;Update with new current column number MUL CHRWID,R1 ;Convert to coordinate MOV R1,VD$X(R5) ;Update x register 50$: SUB CHRHIG,VD$Y(R5) ;Move to next character row DEC CURROW ;Bump the current row number 55$: RETURN 60$: SUB CHRHIG,VD$Y(R5) ;Adjust Y coordinate for next line ;*** NO SMOOTH SCROLL *** ; MOV #<1>,D$SCLM ;Indicate scrolling direction ; BIT #,VD$CSR(R5) ;240 or 480 line mode? ; BEQ 65$ ;Branch if 240 ; INC D$SCLM ;Make 2 for 480 mode ;*** NO SMOOTH SCROLL *** 65$: RETURN .DSABL LSB .ENABL LSB VECUP: MOV R4,R2 ;Get number of lines moved MOV TOPROW,R0 ;Make top row to scroll out ASL R0 ;Get offset to start of vector table MOV R0,-(SP) ;Save offset MOV #CELSTR,R1 ;R1 -> start of cell vector table $REL .-2,CELSTR,PIV ADD R0,R1 ;R1 -> vector entry for column to scroll out MOV #LINCEL+2,R0 ;Start of line cell table (2nd entry) $REL .-2,LINCEL+2,PIV ADD (SP)+,R0 ;Point to current row entry word MOV (R1)+,-(SP) ;Save top pointer 5$: MOV (R1)+,-4(R1) ;Shift the vectors by one MOV (R0)+,-4(R0) ;Shift line rendition word SOB R2,5$ BIC #,-(R0) ;Initialize line cell MOV (SP)+,-(R1) ;Store top vector to make it last CALLR CELINI ;Initialize cells for current row .DSABL LSB .ENABL LSB VECDWN: MOV R4,R2 ;Get number of lines moved MOV BOTROW,R0 ;Make bottom row to scroll out ASL R0 ;Get offset to start of vector table MOV R0,-(SP) ;Save offset MOV #CELSTR,R1 ;R1 -> start of cell vector table $REL .-2,CELSTR,PIV ADD R0,R1 ;R1 -> vector entry for column to scroll out MOV #LINCEL,R0 ;Start of line cell table $REL .-2,LINCEL,PIV ADD (SP)+,R0 ;R0 -> Point to end line cell entry MOV @R1,-(SP) ;Save top pointer 5$: MOV -(R1),2(R1) ;Shift the vectors by one MOV -(R0),2(R0) ;Shift line cell by one SOB R2,5$ BIC #,@R0 ;Initialize line cell MOV (SP)+,@R1 ;Store top vector to make it last CELINI: MOV @R1,R1 ;Point to first column in row MOV MAXCOL,R0 ;Set up count INC R0 ; MOV #BLANK,R2 ;Set up character cell entry 10$: MOV R2,(R1)+ ;Initialize character cell entry SOB R0,10$ ;Branch until done RETURN .DSABL LSB .SBTTL Screen and line clear subroutines ;+ ;R0 = 0 CLCURO ; + SCRCLR ; - IMCLER ;- .ENABL LSB CLRREG:: ;+ CALL SCWAIT ;Wait for scrolling to finish ;- TST VD$CSR(R5) ;Done with clear? BPL CLRREG ;Branch if not TST R0 ;Check flag for type of clear BMI 10$ ;Clear whole area (R1 and R2 preset) BNE 5$ ;Clear current row (R1 = Y coordiante) MOV VD$Y(R5),R1 ;Clear current row -- get y-co 5$: MOV ROWWRD,R2 ;Number of words in row of characters 10$: BIC #,VD$CSR(R5) ;Clean out writable bits BIS VDMWLC,VD$CSR(R5) ;Word operation, left to right MOV VD$Y(R5),S3VD$Y ;Save y-coordinate MOV R1,S4VD$Y ;Save y coordinate to clear CLR R0 ;Set up for DIV instruction DIV CHRHIG,R0 ;Get row number ASL R0 ;Make it an offset MOV #LINCEL,R1 ;R1 -> Start of line cell table $REL .-2,LINCEL,PIV ADD R0,R1 ;Point to current row entry MOV R1,-(SP) ;Save it MOV R2,R1 ;Get number of words being cleared CLR R0 ;Set up to divide DIV ROWWRD,R0 ;Get number of rows to clear MOV (SP)+,R1 ;Get start of table to clear 15$: BIC #,(R1)+ ;Clear doubling bits SOB R0,15$ ;Loop until done MOV S4VD$Y,VD$Y(R5) ;Load y-co for clear MOV VD$X(R5),-(SP) ;Save x-coordinate CLR VD$X(R5) ;Operation done from left margin MOV R2,R0 ;Get number of words in R0 for call CALL CLRPLN ;Set appropriate planes and clear MOV (SP)+,VD$X(R5) ;Restore x-co MOV S3VD$Y,VD$Y(R5) ;Restore y-coordinate RETURN .DSABL LSB .SBTTL SMOSCL - Smooth scroll clear line routine .ENABL LSB SMOSCL::MOV VD$X(R5),-(SP) ;Save X coordinate MOV SCROCT,R0 ;Line count - forward or reverse BMI 5$ ;Branch if forward SUB R0,SCROCT ;Reverse - indicate lines cleared MOV SCNLIN,VD$Y(R5) ;Clear from the bottom of the screen BR 10$ ;Join common routine 5$: SUB R0,SCROCT ;Forward - indicate lines cleared MOV R0,-(SP) ;Set y coordinate for line clear BIC SCLMSK,@SP ;Clear out extraneous bits MOV (SP)+,VD$Y(R5) ;Y coordinate of first one scrolled out NEG R0 ;Make line count positive 10$: .REPT 6 ;Multiply by 64 for words ASL R0 .ENDR CLR VD$X(R5) ;Clear from left margin BIC #VDOCD$,VD$CSR(R5) ;Clean out writable bits BIS VDMWLC,VD$CSR(R5) ;Word operation, left to right CALL CLRPLN ;Set appropriate planes and clear MOV (SP)+,VD$X(R5) ;Restore X coordinate RETURN .DSABL LSB .SBTTL SETDEF - Set default parameter values ;+ ;SETDEF ;This routine is called by routines that require 2 parameters. In all cases, ;the first default is 1. If the second parameter was defaulted, the value ;stored is 0 which is then handled by the calling routine instead of this ;routine. ; ;Call: CALL SETDEF ;Store default values in escape buffer ; ;Output: R1 = Biased first parameter (actual internal line number) ; R2 -> Second byte (second parameter) of escape buffer ;- .ENABL LSB SETDEF: MOV EBPTRE,R3 ;R3 -> Start of default buffer (Actual ESCDEF) MOV #ESCBUF,R2 ;R2 -> start of parameter buffer $REL .-2,ESCBUF,PI TSTB (R3)+ ;First parameter a default? BEQ 5$ ;Branch if no MOVB #1,@R2 ;Set top default to 1 5$: TSTB (R3)+ ;Second parameter a default? BEQ 10$ ;Branch if no CLRB 1(R2) ;Set bottom default (0 - let caller handle it) 10$: CLR R1 ;Set second parameter default value BISB (R2)+,R1 ;Get row value BEQ 15$ ;Branch if equal - top row DEC R1 ;Adjust for 0 to 23 15$: RETURN NOPARM: MOV #ESCBUF,R2 ;R2 -> start of parameter buffer $REL .-2,ESCBUF,PI CMP R2,EBPTR ;Start and end buffer pointers the same? BNE 20$ ;Branch if no CLRB @R2 ;No parameter specified set default to 0 INC EBPTR ;Update pointer to show presents of parameter 20$: RETURN .DSABL LSB .SBTTL RISTAT - Reset to initial state ;+ ;RISTAT ;Resets the terminal to the initial state ;- .ENABL LSB RISTAT: MOV #RISFLG,R5 ;Point to $XMPTR table for flag table $REL .-2,RISFLG,PIV CALL RSTTBL ;Reset tables MOV #RISTAB,R5 ;Point to $XMPTR table for tab stop table $REL .-2,RISTAB,PIV CALL RSTTBL ;Reset tables MOV VD$SLT,R5 ;Get start address of video registers MOV SS$BG,VD$CMP(R5) ;Setup background color MOV SS$FG,VD$CMP(R5) ;Setup foreground color MOVB A$G0,CHRSET ;G0 as current character set CLRB D$SISO ;Reset to shift in CLRB D$SSI ;Initialize single shift flag CLR TOPROW ;Set TOPROW to top of screen CLR TOPLIN ;Set TOPLIN to top of screen MOV #,CHRHIG ;Get default character height MOV #<177400>,SCLMSK ;Set default bit mask for scrolling reg value MOV #<256.>,MLISL ;Set memory length in scan lines for 240 mode MOV CHRHIG,R1 ;Get height of character MOV #<*CHRTMP>,BOTLIN ;Scan line bottom .IF NE MMG$T ;If XM MOV #,WDCHNK ;# of 32 word chunks one printable row MOV #,PXLRAD ;Address of line to move MOV #,PXLLPC ;# of words in line to move (LOOP COUNT) .ENDC ;NE MMG$T BIT #,VD$CSR(R5) ;480 interlace display set? BEQ 5$ ;Branch if no ASL CHRHIG ;Double character height MOV #<177000>,SCLMSK ;Set bit mask for scrolling reg value (480) ASL BOTLIN ;Double the number of lines to bottom ASL MLISL ;Double the memory length in scan lines ASL R1 ;Character height must be doubled in R1 .IF NE MMG$T ;If XM ASL WDCHNK ;Double 32 word chunks for 480 interlace ASL PXLRAD ;Address of line to move for 480 interlace ASL PXLLPC ;# of words in line to move (480 LOOP COUNT) .ENDC ;NE MMG$T 5$: .IF NE MMG$T .REPT 3 ;Calculate words in a line to move ASR PXLLPC .ENDR .ENDC ;NE MMG$T MOV MLISL,R0 ;Compute Y SUB R1,R0 ; coordinate of SUB R1,R0 ; next to last MOV R0,SCRNBD ; display row CLR R0 ;Set up for multiply MOV #,R1 ;Get number of text lines in a screen MOV R1,BOTROW ;Set BOTROW to bottom of screen MUL CHRHIG,R1 ;Get number of pixel lines in screen MOV R1,BOTLIN ;Set BOTLIN to last ROW of screen MOV R1,SCRBOT ;Set SCRBOT to last ROW of screen ADD CHRHIG,R1 ;Add in text line below screen MOV R1,SCNLIN ;Update number of visible scan lines on screen CLR R0 ;Set up for Multiply MOV #SCRWID,R1 ;Get number of words in a scan line MUL CHRHIG,R1 ;Multiply by number of scan lines in row MOV R1,ROWWRD ;Update # of words in a character row CLRB D$ATT ;Reset character renditions CLRB D$OM ;Reset origin mode to absolute MOVB #,D$CUR ;Re-enable text cursor .IF NE MMG$T ;If XM MOV #12.,CHRWID ;Assume 80 column MOV #79.,MAXCOL ;Store number of columns TSTB D$COLM ;Set column mode flag byte BEQ 10$ ;Setting to 80 column MOV #7,CHRWID ;Set character height for 132 MOV #131.,MAXCOL ;Store number of columns (0 bias) .ENDC ;NE MMG$T 10$: MOV #CHRCEL,R1 ;Point to start of character cell table $REL .-2,CHRCEL,PIV MOV #CELWRD,R3 ;Get number of words in the character cell MOV #BLANK,R0 ;Get character cell entry to move into cell 15$: MOV R0,(R1)+ ;Initialize cell entry SOB R3,15$ ;Loop until done CLR CLRPAT ;Assume background is dark TSTB D$SCNM ;Reverse or normal screen BEQ 20$ ;Branch if background is dark COM CLRPAT ;Make background light 20$: CALL CLRSCR ;Clear screen and line renditions ;Also resets X, Y, CURROW, CURCOL, AND PRVCHR CLR EOLFLG ;Reset last column flag CALLR DECSC ;Go save the cursor and return RSTTBL: MOV (R5)+,R2 ;Get address to read from .IF NE MMG$T ;If XM MOV (R5)+,R1 ;Get PAR value .ENDC ;NE MMG$T TST (R5)+ ;Point past size CALLR MOVETO ;Set up destination pointers and do the move MOVETO: CLR R4 ;Non-indexed move so clear index MOVITO: ADD (R5)+,R4 ;Add address pointer to index in R4 .IF NE MMG$T ;If XM MOV (R5)+,R3 ;Get PAR1 value .ENDC ;NE MMG$T MOV @R5,R5 ;Get word count of transfer .BR $BLKMV ;Do memory-to-memory transfer $BLKMV: .IF NE MMG$T ;If XM MOV @#P1EXT,R0 ;Point to RMON fixed offset $REL .-2,P1EXT,RMON CALLR BLKMOV(R0) ;Do the block move .IFF ;If FB 25$: MOV (R2)+,(R4)+ ;Move a word SOB R5,25$ ;Until count is exhausted RETURN .ENDC ;NE MMG$T .DSABL LSB .SBTTL DECNUM - Convert binary value to decimal representation in ASCII ;+ ;DECNUM ;This routine converts a binary value to ASCII characters and stores them in ;an output buffer. The representation is a decimal value. ; ;Entry: R4 -> Next byte in buffer to store string ; R0 = Value - 1 to convert to string ; ;Call: CALL DECNUM ;Cnvt value to decimal representation (ASCII) ; ;Exit: R4 -> Next available byte in buffer ; R0, R1, and R3 are modified ;- .ENABL LSB DECNUM: INC R0 ;Adjust for relative position (not absolute) MOV #PWRTEN,R3 ;R3 -> end power of ten table $REL .-2,PWRTEN,PI 5$: CMP R0,-(R3) ;Look for first significant digit BLO 5$ ;Branch if not found TST (R3)+ ;R3 -> next higher power of ten 10$: MOVB #<'0>,R1 ;Set up with ASCII base TST -(R3) ;-> next lower power of ten BNE 20$ ;Branch if not digit in tens place remains ADD R0,R1 ;Convert final digit to ASCII MOVB R1,(R4)+ ;Store it in the buffer RETURN 15$: INC R1 ;Increment ASCII digit value 20$: SUB @R3,R0 ;Decrement value by power of ten BHIS 15$ ;Branch until done ADD @R3,R0 ;Adjust old value to new to go back to loop MOVB R1,(R4)+ ;Move character into buffer BR 10$ ;Loop for next digit .WORD 0,10.,100.,1000.,10000. ;Power of ten table PWRTEN: ;End of table (pointer start) .DSABL LSB .PSECT PIV D,RW CURSAV::.BYTE 0 ;G0 character set .BYTE 0 ;G1 character set .WORD 0 ;Current character set .WORD 0 ;End of line flag .WORD 0 ;Current column number .WORD 0 ;Current row number .BYTE 0 ;Character attributes .BYTE 0 ;Origin mode .EVEN CURCHR::.BLKW CBUFSZ*2 ;Buffer for pixel rows of current character DBLCHR::.BLKW CBUFSZ ;Temporary buffer for single representation ; of character for doubling .SBTTL LINCEL - Line cell map ;+ ;LINCEL ;LINE WORD ON EACH LINE WITH 3 BITS OF LINE ATTRIBUTE ; ; 15 8 7 3 2 0 ; +---+---+---+---+---+---+---+---|---+---+---+---+---+---+---+---+ ; |BLK| RESERVED |CHG| RESERVED | LINE ATTR.| ; +---+---+---+---+---+---+---+---|---+---+---+---+---+---+---+---+ ; 1 WORD PER LINE FOR LINK LIST OR VECTOR ;- LINCEL::.BLKW CHRLIN+1 ;Number of character lines .SBTTL CHRCEL - Character cell map ;+ ;CHRCEL ;Each character on the screen is represented in the following matrix. ;The matrix for FB is 24 by 81 words (XM - 24 by 133). There is one ;word associated with each character and its attributes. The ASCII ;character is in the low byte (first 8 bits) and the character attri- ;butes are in bits 9 to 12. Bits 13-16 is the value of the character ;set used for the character.For every set of characters in a line ;there is a word which contains at this point the line attribute (thus ;the additional word per line. ; ;BLINK = 100000 ;BOLD = 40000 ;UNDERS = 20000 ;REVERS = 10000 ;FONTS = 7000 ;CHANGE = 400 ;RESERV = 200 ;CHAR = 177 ; ; 15 14 13 12 11 9 8 7 0 ; +---+---+---+---+---+---+---+---|---+---+---+---+---+---+---+---+ ; |BLK|BLD|UNS|REV| FONT TYPE |CHG|RES| ASCII CHARACTER | ; +---+---+---+---+---+---+---+---|---+---+---+---+---+---+---+---+ ;- .IF EQ MMG$T ;If not XM CELLSZ == 80.*2 .IFF ;If XM CELLSZ == 132.*2 .ENDC ;NE MMG$T CELSTR:: .WORD CHRCEL + ;Row 1 - screen begins $REL .-2,CHRCEL+,PIV .WORD CHRCEL + ;Row 2 $REL .-2,CHRCEL+,PIV .WORD CHRCEL + ;Row 3 $REL .-2,CHRCEL+,PIV .WORD CHRCEL + ;Row 4 $REL .-2,CHRCEL+,PIV .WORD CHRCEL + ;Row 5 $REL .-2,CHRCEL+,PIV .WORD CHRCEL + ;Row 6 $REL .-2,CHRCEL+,PIV .WORD CHRCEL + ;Row 7 $REL .-2,CHRCEL+,PIV .WORD CHRCEL + ;Row 8 $REL .-2,CHRCEL+,PIV .WORD CHRCEL + ;Row 9 $REL .-2,CHRCEL+,PIV .WORD CHRCEL + ;Row 10 $REL .-2,CHRCEL+,PIV .WORD CHRCEL + ;Row 11 $REL .-2,CHRCEL+,PIV .WORD CHRCEL + ;Row 12 $REL .-2,CHRCEL+,PIV .WORD CHRCEL + ;Row 13 $REL .-2,CHRCEL+,PIV .WORD CHRCEL + ;Row 14 $REL .-2,CHRCEL+,PIV .WORD CHRCEL + ;Row 15 $REL .-2,CHRCEL+,PIV .WORD CHRCEL + ;Row 16 $REL .-2,CHRCEL+,PIV .WORD CHRCEL + ;Row 17 $REL .-2,CHRCEL+,PIV .WORD CHRCEL + ;Row 18 $REL .-2,CHRCEL+,PIV .WORD CHRCEL + ;Row 19 $REL .-2,CHRCEL+,PIV .WORD CHRCEL + ;Row 20 $REL .-2,CHRCEL+,PIV .WORD CHRCEL + ;Row 21 $REL .-2,CHRCEL+,PIV .WORD CHRCEL + ;Row 22 $REL .-2,CHRCEL+,PIV .WORD CHRCEL + ;Row 23 $REL .-2,CHRCEL+,PIV .WORD CHRCEL + ;Row 24 $REL .-2,CHRCEL+,PIV .WORD CHRCEL + ;Row 25 - for scrolling $REL .-2,CHRCEL+,PIV CHRCEL:: .IF NE MMG$T ;If XM .REPT *132. ;For 80 and 132 column mode .WORD BLANK .ENDR .IFF ;If FB .REPT *80. ;For 80 column only .WORD BLANK .ENDR .ENDC ;NE MMG$T ;+ ;Pointers for RESET sequence RIS. ;- RISFLG::$XMPTR P.SETD,LENSET+1/2,PIV,PIK $XMPTR C.SETD,LENSET+1/2,PIV,PIRV RISTAB::$XMPTR P.TABS,LENTAB/2,PIV,PIK $XMPTR C.TABS,LENTAB/2,PIV,PIV ;+ ;Pointers for compressed fonts tables. ;- C$SET:: .WORD VD$MUS-<*2> ;US character set $REL .-2,VD$MUS-<*2>,PIV .WORD VD$MLN-<137*2> ;Line drawing set $REL .-2,VD$MLN-<137*2>,PIV .WORD VD$MNR-<*2> ;National character set $REL .-2,VD$MNR-<*2>,PIV .END