subroutine cursor(ichar) C C This subroutine allows for single character input C via special terminal mode. C byte leadin(2) ! ** TSX ** integer ilead ! ** TSX ** equivalence(ilead,leadin(1)) ! ** TSX ** integer ich(3) ilead=ispy(-4) !get current activation char.** TSX ** call bitset("44,"10000) !set bit 12 of JSW type 5,leadin(1),'S',' ' !turn on single char.mode ** TSX ** do 15 i=1,3 10 ich(i)=ittinr(0) !get a character if(ich(1).ne.27)goto 20 !if the 1st char <> ESC :branch 15 if(ich(i).eq.0)goto 10 !make sure there's one there 20 if(ich(1).ne.27)ich(3)=ich(1) ichar=ich(3) type 5,leadin(1),'T',' ' !turn off single char.mode ** TSX ** call bitclr("44,"10000) !clear bit 12 of JSW 5 format(1H+,A1,$) ! ** TSX ** return end C subroutine cpos type 1,27,27,27 1 format('$'A1'[23;8H'A1'[7mUse the up/down arrows to select- + Use left/right arrows to exit'A1'[0m') RETURN end subroutine arrow(min,max,icol,irow) if(icol.lt.10.and.irow.lt.10)type 10,27,irow,icol,27,1,27 if(icol.ge.10.and.irow.lt.10)type 11,27,irow,icol,27,1,27 if(icol.lt.10.and.irow.ge.10)type 12,27,irow,icol,27,1,27 if(icol.ge.10.and.irow.ge.10)type 13,27,irow,icol,27,1,27 10 format('$'A1'['I1';'I1'H'A1'[7;'I1'm->'A1'[0m') 11 format('$'A1'['I1';'I2'H'A1'[7;'I1'm->'A1'[0m') 12 format('$'A1'['I2';'I1'H'A1'[7;'I1'm->'A1'[0m') 13 format('$'A1'['I2';'I2'H'A1'[7;'I1'm->'A1'[0m') 20 call cursor(ichar) if(ichar.eq.67.or.ichar.eq.68)goto 40 if(icol.lt.10.and.irow.lt.10)type 30,27,irow,icol if(icol.ge.10.and.irow.lt.10)type 31,27,irow,icol if(icol.lt.10.and.irow.ge.10)type 32,27,irow,icol if(icol.ge.10.and.irow.ge.10)type 33,27,irow,icol 30 format('$'A1'['I1';'I1'H ') 31 format('$'A1'['I1';'I2'H ') 32 format('$'A1'['I2';'I1'H ') 33 format('$'A1'['I2';'I2'H ') if(ichar.eq.65)irow=irow-1 if(ichar.eq.66)irow=irow+1 if(irow.lt.min)irow=max if(irow.gt.max)irow=min if(icol.lt.10.and.irow.lt.10)type 10,27,irow,icol,27,1,27 if(icol.ge.10.and.irow.lt.10)type 11,27,irow,icol,27,1,27 if(icol.lt.10.and.irow.ge.10)type 12,27,irow,icol,27,1,27 if(icol.ge.10.and.irow.ge.10)type 13,27,irow,icol,27,1,27 goto 20 40 if(icol.lt.10.and.irow.lt.10)type 10,27,irow,icol,27,7,27 if(icol.ge.10.and.irow.lt.10)type 11,27,irow,icol,27,7,27 if(icol.lt.10.and.irow.ge.10)type 12,27,irow,icol,27,7,27 if(icol.ge.10.and.irow.ge.10)type 13,27,irow,icol,27,7,27 return end subroutine iobox(ival,nchars,irow,icol,max,min,inc) if(nchars.eq.1.and.irow.lt.10)type 10,27,irow,icol,27,1,ival,27 if(nchars.eq.1.and.irow.ge.10)type 11,27,irow,icol,27,1,ival,27 if(nchars.eq.2.and.irow.lt.10)type 12,27,irow,icol,27,1,ival,27 if(nchars.eq.2.and.irow.ge.10)type 13,27,irow,icol,27,1,ival,27 10 format('$'A1'['I1';'I2'H'A1'[7;'I1'm'I1,A1'[0m') 11 format('$'A1'['I2';'I2'H'A1'[7;'I1'm'I1,A1'[0m') 12 format('$'A1'['I1';'I2'H'A1'[7;'I1'm'I2,A1'[0m') 13 format('$'A1'['I2';'I2'H'A1'[7;'I1'm'I2,A1'[0m') 20 call cursor(ichar) if(ichar.eq.67.or.ichar.eq.68)goto 30 if(icol.ne.48)goto 22 !this is for ispeed only if(ichar.eq.65)ival=ival*2 if(ichar.eq.66)ival=ival/2 goto 25 22 if(ichar.eq.65)ival=ival+inc if(ichar.eq.66)ival=ival-inc 25 if(ival.lt.min)ival=max if(ival.gt.max)ival=min if(nchars.eq.1.and.irow.lt.10)type 10,27,irow,icol,27,1,ival,27 if(nchars.eq.1.and.irow.ge.10)type 11,27,irow,icol,27,1,ival,27 if(nchars.eq.2.and.irow.lt.10)type 12,27,irow,icol,27,1,ival,27 if(nchars.eq.2.and.irow.ge.10)type 13,27,irow,icol,27,1,ival,27 goto 20 30 if(nchars.eq.1.and.irow.lt.10)type 10,27,irow,icol,27,7,ival,27 if(nchars.eq.1.and.irow.ge.10)type 11,27,irow,icol,27,7,ival,27 if(nchars.eq.2.and.irow.lt.10)type 12,27,irow,icol,27,7,ival,27 if(nchars.eq.2.and.irow.ge.10)type 13,27,irow,icol,27,7,ival,27 return end C C BITCLR and BITSET are taken from RT-11 TECHNICAL USER'S SERIES C PROGRAMMING WITH RT-11 VOLUME 2 p.29,30 C C SUBROUTINE BITSET(IADDR,IMASK) IOLD=IPEEK(IADDR) INEW=IOLD.OR.IMASK CALL IPOKE(IADDR,INEW) RETURN END C SUBROUTINE BITCLR(IADDR,IMASK) IOLD=IPEEK(IADDR) INEW=IOLD.AND..NOT.IMASK CALL IPOKE(IADDR,INEW) RETURN END C subroutine single(ichar) C C This subroutine allows for single character input C via special terminal mode.It will run under either C RT-11 or TSX-Plus(V.5 or higher)by first determining C the monitor type. logical ival ! ** TSX ** byte leadin(2) ! ** TSX ** integer ilead ! ** TSX ** equivalence(ilead,leadin(1)) ! ** TSX ** call montyp(ival) !RT-11 or TSX-Plus? ** TSX ** if(ival)ilead=ispy(-4) !get current activation char.** TSX ** call bitset("44,"10000) !set bit 12 of JSW if(ival)type 5,leadin(1),'S',' '!turn on single char.mode ** TSX ** 10 ichar=ittinr(0) !get a character if(ichar.eq.0)goto 10 !make sure there's one there ichar=ichar-48 !convert from ASCII if(ival)type 5,leadin(1),'T',' '!turn off single char.mode ** TSX ** call bitclr("44,"10000) !clear bit 12 of JSW 5 format(1H+,A1,$) ! ** TSX ** return end C subroutine montyp(ival) C C subroutine to test whether running under RT-11 C or TSX-Plus V5 or higher C ival is .TRUE.(ie.bit 15 is set) if running under TSX-Plus C and .FALSE.(bit 15 if off) if running under RT-11 C DEC(RT-11) and S&H(TSX-Plus)have co-operated in allocating C bit 15 in the SYSGEN options word at fixed offset 372 to C indicate which monitor is running. The test is valid only for C TSX-Plus V5.0 or later. C logical ival iaddr=ispy("372) !get value at RMON offset 372 ival=iaddr.or."100000 !mask bit 15 return end