.title scrpkg - screen package .ident -010300- .enabl lc ; Disable LC at your own risk!!! ; ;+ ; Abstract: sckpkg ; ; This implements a screen addressing package for use from ; Assembler or Fortran programs. It is intended as a ; parallel implementation to the PL/I screen package in ; MERLIN.OLB. ; ; Calling sequence: ; ; Fortran entry points have normal names. Assembler ; entry points have names beginning with '$'. ; A Fortran entry point has the calling sequence as shown. ; An assembler entry point has the parameters specified in ; successive registers starting with 0 (i. e., argument 1 ; is in register 0, etc). ; ; $scadr (lun, x, y) ; - Position to screen address (x, y) ; ; $sceol (lun, x, y) ; - Clear from position indicated to end of line ; ; $sceos (lun, x, y) ; - Clear from position indicated to end of screen ; ; $scclr (lun) ; - Clear the entire terminal screen and home the ; cursor. ; ; $scout (lun, string, [length]) ; - Write 'string' to the screen. If length <= 0 ; or not specified, write 'string' as a 0-trailed ; string; otherwise, write 'string' as a fixed- ; length string ; ; $sctyp (lun, type, support) ; - Returns the following information: ; type - The terminal type of the terminal. ; support - The support category for this terminal: ; 0 - The terminal is unsupported. ; 1 - The terminal requires simulation of the ; clear to end of line and clear to end of ; screen functions. ; 2 - The terminal is fully supported. ; ; $scbuf (lun, mode) ; - Set buffering mode ; mode = 0 - write data as soon as it is received. ; This is the default mode. If this is ; specified when data is in the buffer, ; the buffer will be automatically ; flushed as if $scflu were called. ; mode = 1 - Write data as buffer is full. This ; will result in more efficient execution ; if frequent calls are made. ; ; $scflu (lun) ; - Flush output buffer ; In buffering mode 0 this has no effect. In mode 1, ; this has the effect of dumping the screen buffer ; immediately. It is used when output to the screen ; is temporarily suspended (say for a mark time to ; complete or for data to be entered from the keyboard) ; ; Nonstandard features: ; ; 1. Written in Macro-11 ; 2. Allows arguments to be passed in registers ; 3. Uses locally defined terminal types T.ADM1, T.HP48, ; etc. These are not difficult to add to the terminal ; driver under IAS: the TTSYM$ macro in the system ; library LB0:[1,1]RSXMAC.SML must be edited to include ; any special terminal types (along with their numeric ; codes), and the terminal handler file [311,114]CONFIG.MAC ; must be edited to add the new terminal types. In both ; cases the code used to define DEC terminal types should ; be followed. The locally-defined terminal types should ; have numeric codes following the DEC terminal types; ; a reasonable strategy is to have the locally-defined ; types starting at 31. (the maximum number) and counting ; down toward the DEC terminal types. If support for ; non-standard terminals is desired but this seems like ; too much trouble, the symbols T.USR0 .. T.USRn can be ; used (and defined in the package's tables in a manner ; similar to the above non-DEC terminal types). ; ; Limitations: ; ; This package requires about 1K bytes, and must go in the ; root of an overlaid task. If support for fewer terminals ; is desired, it is easy to remove some terminal types, but ; the amount of code saved might not be too great. If support ; for more terminal types is desired, it is not difficult to ; add code for more terminal types; the procedure is fairly ; obvious and will not be described here. ; ; Written: 28-Apr-1981, -1.0.0-, Bruce C. Wright ; Modified: 15-May-1981, -1.1.0-, Bruce C. Wright ; Changed to set VT-100 terminals into VT-52 mode, so that ; we don't output garbage when IAS V3.1 or VAX/VMS have ; put the terminal into ANSI mode. ; Modified: 22-May-1981, -1.2.0-, Bruce C. Wright ; Clarified some comments ; Modified: 11-Jun-1981, -1.3.0-, Bruce C. Wright ; Fixed bug in clear-to-end-of-screen code. ; Verified: 11-Jun-1981, -1.3.0-, Bruce C. Wright ;- .sbttl Macro calls ; .mcall qiow$s .macro callr arg jmp arg .endm ; .sbttl Symbolic equates ; esc = 33 ; ESC character ; .sbttl Read/write data area ; ; This area contains various read/write information for the ; screen package. The screen package normally executes in a ; single task's space, and cannot be built into the pure ; root of a task nor into a library. ; saddr: .word 0 ; The address of the address screen routine clreol: .word 0 ; The address of the clear line routine clreos: .word 0 ; The address of the clear to end of screen ; routine clear: .word 0 ; The address of the clear screen routine typbuf: .byte tc.ttp ; Terminal type code for tt handler. type: .byte 0 ; Terminal type code. buftyp: .word 0 ; The buffering type being used (see above) support:.word 0 ; Support class for this terminal. setv100:.asciz "<""[?2l" ; Set VT-100 into ANSI mode. bufptr: .word buffer ; The pointer into the buffer area. buffer: .blkb 80. ; The buffer. bufsiz = .-buffer ; The size of the buffer. bufend: ; End of buffer area. ; .sbttl Read-only data area ; ; This contains the read-only data for the screen package. ; tertbl: .word t.vt52,avt52,cvt52,svt52,lvt52,2 .word t.vt55,avt55,cvt55,svt55,lvt55,2 .word t.vt61,avt61,cvt61,svt61,lvt61,2 .word t.v100,av100,cv100,sv100,lv100,2 ; ; Local terminal types ; .word t.adm1,aadm1,cadm1,sadm1,ladm1,1 .word t.ad31,aad31,cad31,sad31,lad31,2 .word t.adm3,aadm3,cadm3,sadm3,ladm3,1 .word t.hp48,ahp48,chp48,shp48,lhp48,2 .word t.hp21,ahp21,chp21,shp21,lhp21,2 .word t.act4,aact4,cact4,sact4,lact4,2 .word t.mbee,ambee,cmbee,smbee,lmbee,1 .word 0 ; End of terminal type table ; deftyp: .word rtn,rtn,rtn,rtn,0 ; .sbttl scout - write to output ; scout:: mov 2(r5),r0 ; Pick up logical unit number. mov 4(r5),r1 ; Pick up string address. clr r2 ; Assume no length given. cmp (r5),#2 ; Is the length specified? ble $scout ; J if not. mov 6(r5),r2 ; Pick up string length if so. $scout:: ; Assembler entry point. jsr r5,setup ; Setup the runtime environment. tst r2 ; 0-trailed string? beq 30$ ; J if so. 10$: movb (r1)+,r4 ; Get a character. call putch ; Output it. sob r2,10$ ; And loop. 20$: return ; And return to the caller. 30$: movb (r1)+,r4 ; Get a character. beq 20$ ; J if end of string. call putch ; Output it. br 30$ ; And loop. ; .sbttl scadr - Address random point on screen ; scadr:: mov 2(r5),r0 ; Pick up lun. mov 4(r5),r1 ; Pick up x mov 6(r5),r2 ; Pick up y $scadr:: jsr r5,setup ; Setup the runtime environment. callr @saddr ; Address the screen. ; .sbttl sceol - Erase to end of line sceol:: mov 2(r5),r0 ; Pick up lun. mov 4(r5),r1 ; Pick up x mov 6(r5),r2 ; Pick up y $sceol:: jsr r5,setup ; Set up the environment. jsr pc,@saddr ; Address the screen. callr @clreol ; Clear to end of screen. ; .sbttl sceos - Erase to end of screen sceos:: mov 2(r5),r0 ; Pick up lun. mov 4(r5),r1 ; Pick up x mov 6(r5),r2 ; Pick up y $sceos:: jsr r5,setup ; Setup the runtime environment. jsr pc,@saddr ; Address the screen. callr @clreos ; Clear to end of screen. ; .sbttl scclr - Erase entire screen scclr:: mov 2(r5),r0 ; Pick up lun. $scclr:: jsr r5,setup ; Setup the runtime environment. callr @clear ; Address the screen. ; .sbttl scbuf - Set buffering mode ; scbuf:: mov 2(r5),r0 ; Get LUN mov 4(r5),r1 ; Get mode. $scbuf:: tst r1 ; Are we to start flushing buffers? bne 10$ ; J if not. jsr pc,$scflu ; Flush buffer if so. 10$: mov r1,buftyp ; Save buffering type. return ; And return to the caller. ; .sbttl scflu - Flush buffer if necessary. ; scflu:: mov 2(r5),r0 ; Get the LUN. $scflu:: mov r1,-(sp) ; Save registers mov r2,-(sp) ; ... mov bufptr,r2 ; Get the buffer pointer. mov #buffer,r1 ; Get buffer address. sub r1,r2 ; Compute length of buffer. beq 10$ ; J if nothing in buffer. jsr pc,putbuf ; Force out the buffer. 10$: mov r1,bufptr ; Empty the buffer. mov (sp)+,r2 ; Recover r2 mov (sp)+,r1 ; Recover r1 return ; And return to the caller. ; .sbttl sctyp - Return terminal type information ; sctyp:: mov 2(r5),r0 ; Get the LUN jsr pc,$sctyp ; Get the terminal type. mov r1,@4(r5) ; Return terminal type mov r2,@6(r5) ; And return support class. return ; And return. ; $sctyp:: jsr pc,settyp ; Set terminal type. movb type,r1 ; Get type code. mov support,r2 ; Get support class. return ; And return to the caller. .sbttl Support for unsupported terminal types ; ; These routines support unsupported terminal types. For now, ; the screen package does nothing on unsupported terminals. ; aunsup: cunsup: sunsup: lunsup: rtn: return ; Just return to the caller. ; ; Clear to end of line ; simeol: mov r1,-(sp) ; Save X mov #' ,r4 ; Get the character to output. sub #79.,r1 ; Compute (x - 79.) neg r1 ; Compute (79 - x) 10$: call putch ; Output a character. sob r1,10$ ; And output it. mov (sp)+,r1 ; Recover X callr @saddr ; Get back to the position needed. ; ; Clear to end of screen ; simeos: mov r1,-(sp) ; Save X mov r2,-(sp) ; Save Y mov #' ,r4 ; Get the character to output. sub #79.,r1 ; Compute (x - 79.) neg r1 ; Compute (79 - x) 10$: call putch ; Output a character. sob r1,10$ ; And output it. clr r1 ; Position to column 0. inc r2 ; Get to next row. cmp r2,#24. ; Over top of screen? bge 30$ ; J if so. call @saddr ; Move to the position. mov #80.,r1 ; Get the number of blanks. cmp r2,#23. ; Last line? bne 10$ ; J if not. dec r1 ; Only output 79. on last line. br 10$ ; And loop. 30$: mov (sp)+,r2 ; Recover Y mov (sp)+,r1 ; Recover X callr @saddr ; Get back to the position needed. .sbttl DEC VT-52 support routines ; ; These routines support the Digital Equipment Corporation VT-52 ; ; Address VT-52 ; avt52: mov #esc,r4 ; Get call putch ; ... mov #'Y,r4 ; Get Y call putch ; ... mov r2,r4 ; Get Y coordinate. add #32.,r4 ; Offset it properly. call putch ; ... mov r1,r4 ; Get X coordinate. add #32.,r4 ; Offset it properly. callr putch ; ... ; ; Clear VT-52 ; cvt52: mov #esc,r4 ; Get an call putch ; Output it. mov #'H,r4 ; Get an H call putch ; Output it. mov #esc,r4 ; Get an call putch ; Output it mov #'J,r4 ; Get a K callr putch ; Output it. ; ; Clear to end of line ; lvt52: mov #esc,r4 ; Get an call putch ; Output it mov #'K,r4 ; Get a K callr putch ; Output it ; ; Clear to end of screen ; svt52: mov #esc,r4 ; Get an call putch ; Output it mov #'J,r4 ; Get a J callr putch ; Output it .sbttl DEC VT-55 support routines ; ; These routines support the Digital Equipment Corporation VT-55 ; ; Address VT-55 ; avt55 = avt52 ; ; Clear VT-55 ; cvt55 = cvt52 ; ; Clear to end of line ; lvt55 = lvt52 ; ; Clear to end of screen ; svt55 = svt52 .sbttl DEC VT-61 support routines ; ; These routines support the Digital Equipment Corporation VT-61 ; ; Address VT-61 ; avt61 = avt52 ; ; Clear VT-61 ; cvt61 = cvt52 ; ; Clear to end of line ; lvt61 = lvt52 ; ; Clear to end of screen ; svt61 = svt52 .sbttl DEC VT-100 support routines ; ; These routines support the Digital Equipment Corporation VT-100 ; ; Address VT-100 ; av100 = avt52 ; ; Clear VT-100 ; cv100 = cvt52 ; ; Clear to end of line ; lv100 = lvt52 ; ; Clear to end of screen ; sv100 = svt52 .sbttl ADM-1 support routines ; ; These routines support the ADM-1 terminal. ; aadm1: mov #esc,r4 ; Get call putch ; ... mov #'=,r4 ; Get = call putch ; ... mov r2,r4 ; Get y coordinate. add #32.,r4 ; Offset it properly. call putch ; ... mov r1,r4 ; Get X coordinate. add #32.,r4 ; Offset it properly. callr putch ; ... ; ; ; Clear ADM-1 ; cadm1: mov #esc,r4 ; Get ESC call putch ; ... mov #'+,r4 ; Get + callr putch ; ... ; ; Clear to end of line ; ladm1 = simeol ; ; Clear to end of screen ; sadm1 = simeos .sbttl ADM-31 support routines ; ; These routines support the ADM-31 terminal. ; ; Address ADM-31 ; aad31 = aadm1 ; ; Clear ADM-31 ; cad31 = cadm1 ; ; Clear to end of line ; lad31: mov #esc,r4 ; Get ESC call putch ; ... mov #'T,r4 ; Get T callr putch ; Output it and return. ; ; Clear to end of screen ; sad31: mov #esc,r4 ; Get ESC call putch ; ... mov #'Y,r4 ; Get Y callr putch ; Output it and return. .sbttl ADM-3 support routines ; ; These routines support the ADM-3A terminal. ; ; Address ADM-3 ; aadm3 = aadm1 ; ; Clear ADM-3 ; cadm3: mov #26.,r4 ; Get Clear screen call putch ; ... mov #30.,r4 ; Get home cursor callr putch ; Output it and return. ; ; Clear to end of line ; ladm3 = simeol ; ; Clear to end of screen ; sadm3 = simeos .sbttl HP-2648 support routines ; ; These routines support the Hewlett-Packard 2648/2649 terminal. ; ahp48: mov #esc,r4 ; Get call putch ; Output it mov #'&,r4 ; Get & call putch ; ... mov #'a,r4 ; Get a call putch ; ... mov r1,r3 ; Get X coordinate into r3 call cnvdec ; Convert to decimal. mov #'c,r4 ; Get the column indicator. call putch ; Output the character. mov r2,r3 ; Get Y coordinate into R3 call cnvdec ; Convert to decimal. mov #'R,r4 ; Get R callr putch ; Output it and return. ; ; Clear screen ; chp48 = cvt52 ; Same as VT-52 ; ; Clear to end of line ; lhp48 = lvt52 ; Same as VT-52 ; ; Clear to end of screen ; shp48 = svt52 ; Same as VT-52 .sbttl HP-2621 support routines ; ; These routines support the Hewlett-Packard 2621 terminal. ; ; Address HP2621 ; ahp21 = ahp48 ; ; Clear HP2621 ; chp21 = chp48 ; ; Clear to end of line ; lhp21 = lhp48 ; ; Clear to end of screen ; shp21 = shp48 .sbttl ACT4 support routines ; ; These routines support the ACT4 terminal from Micro-term. ; ; Address ACT4 ; aact4: mov #20.,r4 ; Get 20 call putch ; ... mov r2,r4 ; Get y coordinate. call putch ; ... mov r1,r4 ; Get x coordinate. callr putch ; Output it and return. ; ; Clear ACT4 ; cact4: mov #12.,r4 ; Get clear screen callr putch ; Output it and return. ; ; Clear to end of line ; lact4: mov #30.,r4 ; Get clear to end of line. callr putch ; Output it and return. ; ; Clear to end of screen ; sact4: mov #31.,r4 ; Get clear to end of screen. callr putch ; Output it and return. .sbttl Minibee support routines ; ; These routines support the Beehive Minibee terminal. ; ambee: mov #esc,r4 ; Get ESC call putch ; ... mov #'F,r4 ; Get F call putch ; ... mov r2,r4 ; Get Y coordinate call putch ; ... mov r1,r4 ; Get X coordinate. callr putch ; Output it and return ; ; Clear Minibee ; cmbee: mov #esc,r4 ; Get ESC call putch ; ... mov #'E,r4 ; Get E callr putch ; Output it and return. ; ; Clear to end of line ; lmbee = simeol ; ; Clear to end of screen ; smbee = simeos .sbttl cnvdec - Convert R3 to decimal and output ; ; This routine converts R3 to a decimal number and outputs ; it via putch. ; cnvdec: mov r2,-(sp) ; Save r2 clr r2 ; Clear out r2 for div div #10.,r2 ; Get ten's and one's beq 10$ ; J if no ten's add #'0,r2 ; Get an ASCII number. mov r2,r4 ; Into r4 for output. call putch ; Output the result. 10$: add #'0,r3 ; Get an ASCII number. mov r3,r4 ; Into r4 for output. call putch ; Output the result. mov (sp)+,r2 ; Recover r2 return ; And return to the caller. ; .sbttl settyp - Internal subroutine to set type ; ; This is an internal subroutine of the screen package which ; sets up the terminal type tables for the terminal. ; settyp: tstb type ; Is the terminal type known? bne 90$ ; J if so - leave immediately. qiow$s #sf.gmc,r0,#1,,,,<#typbuf,#2,,,,> mov r0,-(sp) ; Save r0 mov #tertbl,r0 ; Point to terminal table. 10$: cmpb type,(r0) ; Found the type? beq 20$ ; J if so. add #14,r0 ; Get to next entry in table. tst (r0) ; To end of table? bne 10$ ; J if not. mov #deftyp-2,r0 ; Point to default terminal description. 20$: tst (r0)+ ; Skip the type word. mov (r0)+,saddr ; Set up screen addressing. mov (r0)+,clear ; Set up screen clear. mov (r0)+,clreos ; Set up clear to end of screen mov (r0)+,clreol ; Set up clear to end of line. mov (r0)+,support ; Set up support class. cmpb type,#t.v100 ; Is it a VT-100? bne 30$ ; J if not, don't force VT-52 mode. mov r1,-(sp) ; Save r1 mov bufptr,r0 ; Get the buffer pointer. mov #setv100,r1 ; Point to string to set. 25$: movb (r1)+,(r0)+ ; Output it. bne 25$ ; ... dec r0 ; Backup to terminating byte. mov r0,bufptr ; Remember the buffer address. mov (sp)+,r1 ; Recover R1 30$: mov (sp)+,r0 ; Recover r0 90$: return ; And return to the caller. ; .sbttl setup - Internal subroutine to setup functions ; ; The setup subroutine is rather strange. It saves the registers ; like the familiar register save coroutine, and checks for ; various conditions on return to the subroutine. In particular, ; it causes a buffer dump if we are in the proper mode. ; setup: jsr pc,settyp ; Set the terminal type. mov r4,-(sp) ; Save r4 mov r3,-(sp) ; Save r3 mov r2,-(sp) ; Save r2 mov r1,-(sp) ; Save r1 mov r5,-(sp) ; Save the return address. mov bufptr,r5 ; Set up the buffer pointer. jsr pc,@(sp)+ ; And co-call the caller. tst buftyp ; Are we to flush the buffer? bne 10$ ; J if not. mov r5,r2 ; Point to the end of buffer. mov #buffer,r1 ; Get the beginning of the buffer. mov r1,r5 ; Into r5 as well. sub r1,r2 ; Anything to output? beq 10$ ; J if not, just return. jsr pc,putbuf ; Output everything if so. 10$: mov r5,bufptr ; Set up the new buffer pointer. mov (sp)+,r1 ; Recover r1 mov (sp)+,r2 ; Recover r2 mov (sp)+,r3 ; Recover r3 mov (sp)+,r4 ; Recover r4 mov (sp)+,r5 ; Recover r5 (from jsr r5,setup) return ; And return to our caller's caller ; .sbttl putch - Internal subroutine to write a character ; ; The putch routine is an internal routine to output a character ; to the internal buffer. ; putch: movb r4,(r5)+ ; Output the character. cmp r5,#bufend ; Over top of buffer? blo 10$ ; J if not. mov r1,-(sp) ; Save registers mov r2,-(sp) ; ... mov #buffer,r1 ; Point to the buffer. mov r5,r2 ; Get the current address. sub r1,r2 ; Get length of buffer. mov r1,r5 ; Remember the buffer pointer. jsr pc,putbuf ; Output the buffer. mov (sp)+,r2 ; Recover r2 mov (sp)+,r1 ; Recover r1 10$: return ; And return to the caller. ; .sbttl putbuf - Write buffer to screen. ; ; This subroutine writes the buffer to the terminal. ; ; On entry, ; ; r0 = LUN ; r1 = buffer ; r2 = length ; putbuf: qiow$s #io.wvb!tf.wal,r0,#1,,,, return ; And return to the caller. .end