From:	CSBVAX::MRGATE!info-vax-RELAY@KL.SRI.COM@SMTP 14-JUN-1988 19:57
To:	ARISIA::EVERHART
Subj:	read function key


Received: from tor.nta.no by KL.SRI.COM with TCP; Thu, 9 Jun 88 09:34:01 PDT
Posted-Date:  9 Jun 88 18:32 +0100
Received: by tor.nta.no (5.54/3.21)
	id AA15153; Thu, 9 Jun 88 18:36:32 +0200
Date:  9 Jun 88 18:32 +0100
From: Joern Yngve Dahl-Stamnes <dahls%vax.elab.unit.uninett@TOR.nta.no>
To: <info-vax@kl.sri.com>
Message-Id: <147*dahls@vax.elab.unit.uninett>
Subject: read function key


This is a small ex. of how to read the function keys from a terminal. 
The basic routine is GET_KEY.

  +-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-+
  ! The University of Trondheim           ! Joern Yngve Dahl-Stamnes  !
  ! The Norwegian Institute of Technology ! System Manager            !
  ! Division of Physical Electronics      !                           !
  ! N 7034 Trondheim, Norway              !                           !
  !---------------------------------------+---------------------------!
  !             dahls%vax.elab.unit.uninett@tor.nta.no                !
  !------->>>>>>>>     %SYSTEM-F-NOBIT, no such bit     <<<<<<<<------!
  +-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-+

....................... Cut between dotted lines and save. .....................
$!.............................................................................
$! VAX/VMS archive file created by VMS_SHARE V06.00 26-May-1988.
$!
$! VMS_SHARE was written by James Gray (Gray:OSBUSouth@Xerox.COM) from
$! VMS_SHAR by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au).
$!
$! To unpack, simply save, concatinate all parts into onefile and
$! execute (@) that file.
$!
$! This archive was created by user DAHLS
$! on  6-APR-1866 20:07:23.77.
$!
$! It contains the following 1 file:
$!        GETKEY.FOR
$!
$!=============================================================================
=
$ SET SYMBOL/SCOPE=( NOLOCAL, NOGLOBAL )
$ VERSION = F$GETSYI( "VERSION" )
$ IF VERSION .GES "V4.4" THEN GOTO VERSION_OK
$ WRITE SYS$OUTPUT "You are running VMS ''VERSION'; ", -
    "VMS_SHARE V06.00 26-May-1988 requires VMS V4.4 or higher."
$ EXIT 44 
$VERSION_OK:
$ GOTO START
$
$UNPACK_FILE:
$ WRITE SYS$OUTPUT "Creating ''FILE_IS'"
$ DEFINE/USER_MODE SYS$OUTPUT NL:
$ EDIT/TPU/COMMAND=SYS$INPUT/NODISPLAY/OUTPUT='FILE_IS'/NOSECTION -
    VMS_SHARE_DUMMY.DUMMY
b_part := CREATE_BUFFER( "{Part}", GET_INFO( COMMAND_LINE, "file_name" ) )
; s_file_spec := GET_INFO( COMMAND_LINE, "output_file" ); SET( OUTPUT_FILE
, b_part, s_file_spec ); b_errors := CREATE_BUFFER( "{Errors}" ); i_errors 
:= 0; pat_beg_1 := ANCHOR & "-+-+-+ Beginning"; pat_beg_2 := LINE_BEGIN 
& "+-+-+-+ Beginning"; pat_end := ANCHOR & "+-+-+-+-+ End"; POSITION
( BEGINNING_OF( b_part ) ); i_append_line := 0; LOOP EXITIF MARK( NONE 
) = END_OF( b_part ); s_x := ERASE_CHARACTER( 1 ); IF s_x = "+" THEN r_skip 
:= SEARCH( pat_beg_1, FORWARD, EXACT ); IF r_skip <> 0 THEN s_x := ""
; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ERASE_LINE; ENDIF; ENDIF
; IF s_x = "-" THEN r_skip := SEARCH( pat_end, FORWARD, EXACT ); IF r_skip <
> 0 THEN s_x := ""; MOVE_HORIZONTAL( -CURRENT_OFFSET ); m_skip := MARK( NONE )
; r_skip := SEARCH( pat_beg_2, FORWARD, EXACT ); IF r_skip <> 0 THEN POSITION
( END_OF( r_skip ) ); MOVE_HORIZONTAL( -CURRENT_OFFSET ); MOVE_VERTICAL( 1 )
; MOVE_HORIZONTAL( -1 ); ELSE POSITION( END_OF( b_part ) ); ENDIF; ERASE
( CREATE_RANGE( m_skip, MARK( NONE ), NONE ) ); ENDIF; ENDIF
; IF s_x = "V" THEN s_x := ""; IF i_append_line <> 0 THEN APPEND_LINE
; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ENDIF; i_append_line := 1; MOVE_VERTICAL
( 1 ); ENDIF; IF s_x = "X" THEN s_x := ""; IF i_append_line <
> 0 THEN APPEND_LINE; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ENDIF
; i_append_line := 0; MOVE_VERTICAL( 1 ); ENDIF; IF s_x <> "" THEN i_errors 
:= i_errors + 1; s_text := CURRENT_LINE; POSITION( b_errors ); COPY_TEXT
( "The following line could not be unpacked properly:" ); SPLIT_LINE
; COPY_TEXT( s_x ); COPY_TEXT( s_text ); POSITION( b_part ); MOVE_VERTICAL( 1 
); ENDIF; ENDLOOP; POSITION( BEGINNING_OF( b_part ) ); LOOP r_x := SEARCH( "`"
, FORWARD, EXACT ); EXITIF r_x = 0; POSITION( r_x ); ERASE_CHARACTER( 1 )
; IF CURRENT_CHARACTER = "`" THEN MOVE_HORIZONTAL( 1 ); ELSE COPY_TEXT( ASCII
( INT( ERASE_CHARACTER( 3 ) ) ) ); ENDIF; ENDLOOP; IF i_errors = 0 THEN SET
( NO_WRITE, b_errors, ON ); ELSE POSITION( BEGINNING_OF( b_errors ) )
; COPY_TEXT( FAO( "The following !UL errors were detectedwhile unpacking !AS"
, i_errors, s_file_spec ) ); SPLIT_LINE; SET( OUTPUT_FILE, b_errors
, "SYS$COMMAND" ); ENDIF; EXIT; 
$ DELETE VMS_SHARE_DUMMY.DUMMY;*
$ CHECKSUM 'FILE_IS
$ WRITE SYS$OUTPUT " CHECKSUM ", -
  F$ELEMENT( CHECKSUM_IS .EQ. CHECKSUM$CHECKSUM, ",", "failed!,passed." )
$ RETURN
$
$START:
$ FILE_IS = "GETKEY.FOR"
$ CHECKSUM_IS = 1667153695
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
XCASE-; PROG+; MARG-1,72; TAB-F; WHEN 8806 9 17:50:26; VER   44;
X
X      program     demo_get_key
X
X      external    get_key
X      integer*4   get_key
X
X      character*4     msg (9)
X      integer*4       block
X      byte            argblk (37)
X
X      data    argblk  / 09,           ! no of blocks.
X     &                  27,79,80,00,  ! PF1
X     &                  27,79,81,00,  ! PF2
X     &                  27,79,82,00,  ! PF3
X     &                  27,79,83,00,  ! PF4
X     &                  65,00,00,00,  ! A
X     &                  66,00,00,00,  ! B
X     &                  67,00,00,00,  ! C
X     &                  68,00,00,00,  ! D
X     &                  69,88,73,84 / ! EXIT
X      data    msg     / 'PF1 ','PF2 ','PF3 ','PF4 ',
X     &                  'A   ','B   ','C   ','D   ',
X     &                  'EXIT' /
X
X      block = 0
X      do while ( block .ne. 9 )   ! repeat until EXIT
X          block = get_key (argblk,0)
X          write (*,100) block,msg(block)
X      enddo
X
X100   format (x,i3,2x,a4)
X      end
X
XC=====================================================================
X      function        get_key ( argblk,case )
X!
X! Argblk structure (byte array):
X!
X!     arg 1       : no of blocks in argument (n).
X!     blokk 1     : key sequence 1    = argblk(2 : 5)
X!       .
X!       .
X!     blokk n     : key sequence n    = argblk(n*4-2 : n*4+1)
X!
X! If CASE is true, lower case are trans. to upper case.
X!
X! The routine will return a pointer to the block which was satisfied.
X!
X      implicit none
X
X      include     '($iodef)/nolist'
X      include     '($ssdef)/nolist'
X  
X      external    sys$assign, sys$qiow, sys$dassgn
X      integer*4   sys$assign, sys$qiow, sys$dassgn
X
X      integer*4   get_key
X      integer*4   ant, fcnt, fp, func, i, p, status
X      integer*2   channel
X      logical*1   case, key, ant_bin(4), argblk(1:*)
X
X      equivalence (ant,ant_bin(1))
X
X      status = sys$assign (%descr('SYS$OUTPUT'),%ref(channel),,)
X      if ( status .ne. ss$_normal ) call lib$stop (%val(status))
X
X      ant = 0
X      ant_bin(1) = argblk(1)
X
X      p = 0
X      func = io$_ttyreadall .or. io$m_noecho
X      do while ( .true. )
X
X          status = sys$qiow (,%val(channel),%val(func),,,,%ref(key),
X     &        %val(1),,,,)
X          if ( status .ne. ss$_normal ) call lib$stop (%val(status))
X          if ( case .and. key .ge. 97 .and. key .le. 122 ) key = key-32
X
X          fcnt = 0
X          do i = 1,ant
X              if ( key .eq. argblk(i*4+p-2) ) then
X                  if ( argblk(i*4+p-1) .eq. 0 ) then
X                      get_key = i
X                      goto 1000
X                  else
X                      fp = i
X                      fcnt = fcnt+1
X                  endif
X              endif
X          enddo
X          if ( fcnt .gt. 0 ) then
X              if ( fcnt .eq. 1 .and. p .eq. 4 ) then
X                  get_key = fp
X                  goto 1000
X              elseif ( p .eq. 4 ) then
X                  p = 0
X              endif
X              p = p+1
X          else
X              p = 0
X          endif
X      enddo
X
X 1000 continue
X      status = sys$dassgn (%val(channel))
X      if ( status .ne. ss$_normal ) call lib$stop (%val(status))
X
X      return
X      end
X
$ GOSUB UNPACK_FILE
$ EXIT
