home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / term / h19vaxx.esc < prev    next >
Encoding:
Internet Message Format  |  1983-09-09  |  4.2 KB
  1. Date: 23 Jul 1982 1117-PDT
  2. From: SIM at SU-AI
  3. To:   info-vax at SANDIA, h19-people
  4. cc:   SIM at SU-AI
  5. Re:   Reading Escape Sequences with VAX/VMS  
  6.  
  7.     The following FORTRAN-77 subroutine allows VAX/VMS users to read escape
  8. sequences.  This is useful for reading keypad and special function keys on
  9. terminals, reported cursor positions, etc.  The subroutine sets then unsets
  10. (using an exit handler) the terminal characteristic ESCAPE so that you don't
  11. have too.
  12.     To call ReadEscape from Pascal, declare it as follows:
  13.  
  14.     type StringTyp = packed array[1..?] of char;
  15.     procedure ReadEscape( %STDESCR string : StringTyp;
  16.                 var StrLen,EscLen : integer); FORTRAN;
  17.  
  18.     For those of you interested, I have also written routines for single
  19. character input (using QIO reads in PASSALL mode with buffer length equal to
  20. one), and several Heathkit H19 dependent routines:  one to display process
  21. status, priority, terminal name, cpu time, image name, data and time, and
  22. current default directory on the 25th line dynamically while running other
  23. things; another to save everything you see on your screen, including graphics
  24. characters, into a file which can then be edited, printed or typed out (VERY
  25. HANDY!).                        -Stuart McDonald
  26.  
  27. C    Subroutine ReadEscape
  28. C    returns an input string terminated by a <CR> or any valid escape
  29. C    sequence; StrLen is the number of characters before the terminator and
  30. C    EscLen is the number of characters in the terminator.  The total 
  31. C    length of the inputed string is StrLen + EscLen.      -S.McD. 6/6/82
  32.  
  33.     function ReadEscape( string,StrLen,EscLen )
  34.     implicit integer (a-z)
  35.     character*(*) string
  36.     integer ReadEscape,StrLen,EscLen
  37.  
  38.     character    sys$input*9/'SYS$INPUT'/,terminal*63
  39.     external    io$_readvblk,io$_setmode,tt$m_escape,ToggleEsc
  40.     logical        first/.true./
  41.     integer        iosb*2(4)
  42.     common        /stu_escape/cchan    ! common used by ToggleEsc
  43.       save        first,func_code,chan
  44.  
  45.     if (first) then
  46.             ! Define ToggleEsc as an exit handler (see Users Guide)
  47.         call userex(ToggleEsc)
  48.  
  49.             ! Find lowest logical name translation of SYS$INPUT
  50.         call trnlog(sys$input,terminal,name_len)        ! lowest log
  51.         status = sys$assign( terminal, chan,, )        ! open terminal
  52.         if (.not.status) call lib$stop( %VAL(status) )    ! check status
  53.         cchan = chan                    ! load common
  54.         call ToggleEsc                    ! allow esc seq
  55.  
  56.             ! Ready function code for read of escape sequence
  57.         func_code = %LOC(io$_readvblk)            ! ordinary read
  58.         first = .false.
  59.     endif
  60.             ! Read in line and/or escape sequence
  61.     status = sys$qiow( ,%VAL(chan),%VAL(func_code),iosb,,,
  62.     1    %REF(string),%VAL(len(string)),,,,)    ! read esc seq
  63.     if (.not.status) call lib$stop( %VAL(status) )    ! check status
  64.     ReadEscape = iosb(1)                ! rtn i/o stat
  65.     StrLen = iosb(2)            ! # chars before terminator
  66.     EscLen = iosb(4)            ! # chars in terminator
  67.     return
  68.     end
  69.                 ! This came from "Prog. VMS in FORT/MAC",p.83
  70.      subroutine trnlog( old_log,new_log,new_len )
  71.     implicit    integer (a-z)
  72.     byte        esc_null_int(2) /'1B'X,0/
  73.     character*2    esc_null
  74.     character*(*)    old_log,new_log
  75.     external    ss$_notran
  76.     equivalence    (esc_null,esc_null_int)
  77.                 ! Translate name once
  78.     status = sys$trnlog( old_log,new_len,new_log,,, )
  79.     if (status.eq. %LOC(ss$_notran)) stop 'Logical name has no translation'
  80.                 ! Repeat translation until unsuccessful
  81.     do while (status.ne.%LOC(ss$_notran))
  82.         old_log(1:new_len) = new_log
  83.         status = sys$trnlog( old_log(1:new_len),new_len,new_log,,, )
  84.     enddo
  85.                 ! Check if process permanent file
  86.     if (new_log(1:2).eq.esc_null) then
  87.         new_log(1:new_len) = new_log(5:new_len)
  88.         new_len = new_len - 4
  89.     endif
  90.     return
  91.     end
  92.  
  93.     subroutine ToggleEsc    ! Toggles Escape Recognition for Terminals
  94.     implicit    integer (a-z)
  95.     integer        mode_buf(2)
  96.     external    tt$m_escape,io$_setmode,io$_sensemode
  97.     common        /stu_escape/chan    ! Channel passed in my common
  98.  
  99.     func_code = %LOC(io$_sensemode)        ! Get terminal characteristics
  100.     status = sys$qiow( ,%VAL(chan),%VAL(func_code),,,,mode_buf,,,,,)
  101.         if (.not.status) call lib$stop( %VAL(status) )    ! check status
  102.  
  103.     mode_buf(2) = mode_buf(2) .xor. %LOC(tt$m_escape)    ! toggle bits
  104.  
  105.     func_code = %LOC(io$_setmode)        ! Set terminal characteristics
  106.     status = sys$qiow( ,%VAL(chan),%VAL(func_code),,,,mode_buf,,,,,)
  107.         if (.not.status) call lib$stop( %VAL(status) )    ! check status
  108.  
  109.     return
  110.     end
  111.